8a5c4b4 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

0.5.0.0 yissss

8a5c4b4Chris Allen12 years ago

bloodhound.cabal+1−1

compare with master

unifiedsplit

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

1name: bloodhound

2−version: 0.4.0.2

2+version: 0.5.0.0

3synopsis: ElasticSearch client library for Haskell

4description: ElasticSearch made awesome for Haskell hackers

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

changelog.md+12

@@ -1,9 +1,21 @@

1+0.5.0.0

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

4+* Fixed and changed TermsQuery (This caused the major bump)

6+* Removed benchmarks from travis.yml

8+* Added doctests, examples for Database.Bloodhound.Client. Haddocks should be much nicer.

10+* Various fixes, reformatting

11+

10.4.0.0

120.4.0.0

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

13===================

4* Term and date aggregation - thanks to Christopher Guiney! (@chrisguiney)

15* Term and date aggregation - thanks to Christopher Guiney! (@chrisguiney)

6Following three thanks to Liam Atkins (@latkins)

17Following three thanks to Liam Atkins (@latkins)

18+

7* omitNulls changed to exclude empty lists and null values

19* omitNulls changed to exclude empty lists and null values

9* BoolQuery must/mustNot/Should changed from Maybe (Query|[Query]) to [Query] thanks to @latkins

21* BoolQuery must/mustNot/Should changed from Maybe (Query|[Query]) to [Query] thanks to @latkins

src/Database/Bloodhound/Client.hs+80−4

@@ -108,12 +108,22 @@ import Database.Bloodhound.Types

108--instance ToJSON BulkTest

109-- :}

110

111+-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'

112+-- which rejects 'Int' values below 1 and above 1000.

113+--

114+-- >>> mkShardCount 10

115+-- Just (ShardCount 10)

111mkShardCount :: Int -> Maybe ShardCount

116mkShardCount :: Int -> Maybe ShardCount

112mkShardCount n

117mkShardCount n

113 | n < 1 = Nothing

118 | n < 1 = Nothing

114 | n > 1000 = Nothing

119 | n > 1000 = Nothing

115 | otherwise = Just (ShardCount n)

120 | otherwise = Just (ShardCount n)

116

121

122+-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'

123+-- which rejects 'Int' values below 1 and above 1000.

124+--

125+-- >>> mkReplicaCount 10

126+-- Just (ReplicaCount 10)

117mkReplicaCount :: Int -> Maybe ReplicaCount

127mkReplicaCount :: Int -> Maybe ReplicaCount

118mkReplicaCount n

128mkReplicaCount n

119 | n < 1 = Nothing

129 | n < 1 = Nothing

@@ -152,14 +162,17 @@ post = dispatch NHTM.methodPost

152-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html

162-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html

153-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs

163-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs

154

164

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

166+--

167+-- >>> getStatus testServer

168+-- Just (Status {ok = Nothing, status = 200, name = "Arena", version = Version {number = "1.4.1", build_hash = "89d3241d670db65f994242c8e8383b169779e2d4", build_timestamp = 2014-11-26 15:49:29 UTC, build_snapshot = False, lucene_version = "4.10.2"}, tagline = "You Know, for Search"})

155getStatus :: Server -> IO (Maybe Status)

169getStatus :: Server -> IO (Maybe Status)

156getStatus (Server server) = do

170getStatus (Server server) = do

157 request <- parseUrl $ joinPath [server]

171 request <- parseUrl $ joinPath [server]

158 response <- withManager defaultManagerSettings $ httpLbs request

172 response <- withManager defaultManagerSettings $ httpLbs request

159 return $ decode (responseBody response)

173 return $ decode (responseBody response)

160

174

161−-- | createIndex will create an index given a 'Server',

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

162−-- 'IndexSettings', and an 'IndexName'

163--

176--

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

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

165-- >>> respIsTwoHunna response

178-- >>> respIsTwoHunna response

@@ -172,8 +185,7 @@ createIndex (Server server) indexSettings (IndexName indexName) =

172 where url = joinPath [server, indexName]

185 where url = joinPath [server, indexName]

173 body = Just $ encode indexSettings

186 body = Just $ encode indexSettings

174

187

175−-- | deleteIndex will delete an index given a 'Server',

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

176−-- and an 'IndexName'

177--

189--

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

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

179-- >>> response <- deleteIndex testServer (IndexName "didimakeanindex")

191-- >>> response <- deleteIndex testServer (IndexName "didimakeanindex")

@@ -196,6 +208,10 @@ existentialQuery url = do

196 reply <- head url

208 reply <- head url

197 return (reply, respIsTwoHunna reply)

209 return (reply, respIsTwoHunna reply)

198

210

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

212+-- in IO

213+--

214+-- >>> exists <- indexExists testServer testIndex

199indexExists :: Server -> IndexName -> IO Bool

215indexExists :: Server -> IndexName -> IO Bool

200indexExists (Server server) (IndexName indexName) = do

216indexExists (Server server) (IndexName indexName) = do

201 (_, exists) <- existentialQuery url

217 (_, exists) <- existentialQuery url

@@ -223,9 +239,17 @@ openOrCloseIndexes oci (Server server) (IndexName indexName) =

223 where ociString = stringifyOCIndex oci

239 where ociString = stringifyOCIndex oci

224 url = joinPath [server, indexName, ociString]

240 url = joinPath [server, indexName, ociString]

225

241

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

243+-- http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html

244+--

245+-- >>> reply <- openIndex testServer testIndex

226openIndex :: Server -> IndexName -> IO Reply

246openIndex :: Server -> IndexName -> IO Reply

227openIndex = openOrCloseIndexes OpenIndex

247openIndex = openOrCloseIndexes OpenIndex

228

248

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

250+-- http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html

251+--

252+-- >>> reply <- closeIndex testServer testIndex

229closeIndex :: Server -> IndexName -> IO Reply

253closeIndex :: Server -> IndexName -> IO Reply

230closeIndex = openOrCloseIndexes CloseIndex

254closeIndex = openOrCloseIndexes CloseIndex

231

255

@@ -361,6 +385,10 @@ getDocument (Server server) (IndexName indexName)

361 (MappingName mappingName) (DocId docId) =

385 (MappingName mappingName) (DocId docId) =

362 get $ joinPath [server, indexName, mappingName, docId]

386 get $ joinPath [server, indexName, mappingName, docId]

363

387

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

389+-- in IO

390+--

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

364documentExists :: Server -> IndexName -> MappingName

392documentExists :: Server -> IndexName -> MappingName

365 -> DocId -> IO Bool

393 -> DocId -> IO Bool

366documentExists (Server server) (IndexName indexName)

394documentExists (Server server) (IndexName indexName)

@@ -372,27 +400,75 @@ documentExists (Server server) (IndexName indexName)

372dispatchSearch :: String -> Search -> IO Reply

400dispatchSearch :: String -> Search -> IO Reply

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

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

374

402

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

404+-- on an Elasticsearch server. Try to avoid doing this if it can be helped.

405+--

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

407+-- >>> let search = mkSearch (Just query) Nothing

408+-- >>> reply <- searchAll testServer search

375searchAll :: Server -> Search -> IO Reply

409searchAll :: Server -> Search -> IO Reply

376searchAll (Server server) = dispatchSearch url where

410searchAll (Server server) = dispatchSearch url where

377 url = joinPath [server, "_search"]

411 url = joinPath [server, "_search"]

378

412

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

414+-- against all mappings within an index on an Elasticsearch server.

415+--

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

417+-- >>> let search = mkSearch (Just query) Nothing

418+-- >>> reply <- searchByIndex testServer testIndex search

379searchByIndex :: Server -> IndexName -> Search -> IO Reply

419searchByIndex :: Server -> IndexName -> Search -> IO Reply

380searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where

420searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where

381 url = joinPath [server, indexName, "_search"]

421 url = joinPath [server, indexName, "_search"]

382

422

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

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

425+--

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

427+-- >>> let search = mkSearch (Just query) Nothing

428+-- >>> reply <- searchByType testServer testIndex testMapping search

383searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply

429searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply

384searchByType (Server server) (IndexName indexName)

430searchByType (Server server) (IndexName indexName)

385 (MappingName mappingName) = dispatchSearch url where

431 (MappingName mappingName) = dispatchSearch url where

386 url = joinPath [server, indexName, mappingName, "_search"]

432 url = joinPath [server, indexName, mappingName, "_search"]

387

433

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

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

436+-- syntax if you want to add things like aggregations or highlights while still using

437+-- this helper function.

438+--

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

440+-- >>> mkSearch (Just query) Nothing

441+-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 0, size = 10}

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

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

389mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10

443mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10

390

444

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

446+-- the 'Query' and the 'Aggregation'.

447+--

448+-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }

449+-- >>> terms

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

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

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

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

392mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False 0 0

453mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False 0 0

393

454

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

456+-- the 'Query' and the 'Aggregation'.

457+--

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

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

460+-- >>> let search = mkHighlightSearch (Just query) testHighlight

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

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

395mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False 0 10

462mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False 0 10

396

463

464+-- | 'pageSearch' is a helper function that takes a search and assigns the page from and to

465+-- fields for the search.

466+--

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

468+-- >>> let search = mkSearch (Just query) Nothing

469+-- >>> search

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

471+-- >>> pageSearch 10 100 search

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

397pageSearch :: Int -> Int -> Search -> Search

473pageSearch :: Int -> Int -> Search -> Search

398pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize }

474pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize }

src/Database/Bloodhound/Types.hs+7−7

@@ -196,7 +196,7 @@ import Data.Aeson

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

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

198import Data.List (nub)

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

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

200import qualified Data.Map.Strict as M

201import Data.Monoid

202import Data.Text (Text)

@@ -598,7 +598,7 @@ data HighlightTag = TagSchema Text

598

599data Query =

600 TermQuery Term (Maybe Boost)

601− | TermsQuery [Term] MinimumMatch

601+ | TermsQuery (NonEmpty Term)

602 | QueryMatchQuery MatchQuery

603 | QueryMultiMatchQuery MultiMatchQuery

604 | QueryBoolQuery BoolQuery

@@ -1380,12 +1380,12 @@ instance ToJSON Query where

1380 boosted = maybe [] (return . ("boost" .=)) boost

1381 merged = mappend base boosted

1382

1383− toJSON (TermsQuery terms termsQueryMinimumMatch) =

1383+ toJSON (TermsQuery terms) =

1384 object [ "terms" .= object conjoined ]

1385− where conjoined =

1385+ where conjoined = [ getTermsField terms .=

1386− [ "tags" .= fmap toJSON terms

1386+ fmap (toJSON . getTermValue) (toList terms)]

1387− , "minimum_should_match" .= toJSON termsQueryMinimumMatch ]

1387+ getTermsField ((Term f _ ) :| _) = f

1388−

1388+ getTermValue (Term _ v) = v

1389 toJSON (IdsQuery idsQueryMappingName docIds) =

1390 object [ "ids" .= object conjoined ]

1391 where conjoined = [ "type" .= toJSON idsQueryMappingName

tests/tests.hs+14−5

@@ -7,9 +7,10 @@ module Main where

7import Control.Applicative

8import Control.Monad

9import Data.Aeson

10−import Data.HashMap.Strict (fromList)

10+import qualified Data.HashMap.Strict as HM

11import Data.List (nub)

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

13+import qualified Data.List.NonEmpty as NE

13import qualified Data.Map.Strict as M

14import qualified Data.Map.Strict as M

14import Data.Text (Text)

15import Data.Text (Text)

15import qualified Data.Text as T

16import qualified Data.Text as T

@@ -269,6 +270,14 @@ main = hspec $ do

269 myTweet <- searchTweet search

270 myTweet <- searchTweet search

270 myTweet `shouldBe` Right exampleTweet

271 myTweet `shouldBe` Right exampleTweet

271

272

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

274+ _ <- insertData

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

276+ let filter = IdentityFilter <&&> IdentityFilter

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

278+ myTweet <- searchTweet search

279+ myTweet `shouldBe` Right exampleTweet

280+

272 it "returns document for match query" $ do

281 it "returns document for match query" $ do

273 _ <- insertData

282 _ <- insertData

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

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

@@ -542,19 +551,19 @@ main = hspec $ do

542 it "checks that omitNulls drops list elements when it should" $

551 it "checks that omitNulls drops list elements when it should" $

543 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))

552 let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))

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

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

545− in dropped `shouldBe` Object (fromList [("test2", String "some value")])

554+ in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])

546

555

547 it "checks that omitNulls doesn't drop list elements when it shouldn't" $

556 it "checks that omitNulls doesn't drop list elements when it shouldn't" $

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

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

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

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

550− in notDropped `shouldBe` Object (fromList [ ("test1", Array (V.fromList [Number 1.0]))

559+ in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))

551 , ("test2", String "some value")])

560 , ("test2", String "some value")])

552 it "checks that omitNulls drops non list elements when it should" $

561 it "checks that omitNulls drops non list elements when it should" $

553 let dropped = omitNulls $ [ "test1" .= (toJSON Null)

562 let dropped = omitNulls $ [ "test1" .= (toJSON Null)

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

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

555− in dropped `shouldBe` Object (fromList [("test2", String "some value")])

564+ in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])

556 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $

565 it "checks that omitNulls doesn't drop non list elements when it shouldn't" $

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

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

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

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

559− in notDropped `shouldBe` Object (fromList [ ("test1", Number 1.0)

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

560 , ("test2", String "some value")])

569 , ("test2", String "some value")])