6832d1e · typeable/bloodhound

git.iko.soy/typeable/bloodhound

Merged with master

commit6832d1e1231547b66fa62ff7ac9d6df37acd4750 authorLiam Atkinson <liamatkinson@gmail.com> dateWed 19 Nov 2014, 20:15 (12 years ago) parent3ec83ae 4417091

7 files changed+114−75

compare with master

unifiedsplit

.travis.yml+6−5 Database/Bloodhound/Client.hs+34−31 Database/Bloodhound/Types.hs+18−16 LICENSE+8−17 README.org+42−1 bloodhound.cabal+1−1 tests/tests.hs+5−4

.travis.yml+6−5

@@ -7,11 +7,12 @@

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

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

99env:

10− - GHCVER=7.6.3 ESVER=1.3.2

11− - GHCVER=7.8.2 ESVER=1.0.3

12− - GHCVER=7.8.2 ESVER=1.1.2

13− - GHCVER=7.8.2 ESVER=1.2.3

14− - GHCVER=7.8.2 ESVER=1.3.2

10+ - GHCVER=7.6.3 ESVER=1.4.0

11+ - GHCVER=7.8.3 ESVER=1.0.3

12+ - GHCVER=7.8.3 ESVER=1.1.2

13+ - GHCVER=7.8.3 ESVER=1.2.3

14+ - GHCVER=7.8.3 ESVER=1.3.2

15+ - GHCVER=7.8.3 ESVER=1.4.0

1516

1617# services:

1718# - elasticsearch

Database/Bloodhound/Client.hs+34−31

@@ -22,15 +22,18 @@ module Database.Bloodhound.Client

2222 , mkShardCount

2323 , mkReplicaCount

2424 , getStatus

25+ , encodeBulkOperations

26+ , encodeBulkOperation

2527 )

2628 where

2729

2830import Data.Aeson

2931import Data.ByteString.Builder

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

31−import Data.List (foldl', intercalate, intersperse)

33+import Data.List (intercalate)

3234import Data.Maybe (fromMaybe)

3335import Data.Text (Text)

36+import qualified Data.Vector as V

3437import Network.HTTP.Client

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

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

@@ -168,52 +171,53 @@ deleteDocument (Server server) (IndexName indexName)

168171 (MappingName mappingName) (DocId docId) =

169172 delete $ joinPath [server, indexName, mappingName, docId]

170173

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

174+bulk :: Server -> V.Vector BulkOperation -> IO Reply

172175bulk (Server server) bulkOps = post url body where

173176 url = joinPath [server, "_bulk"]

174− body = Just $ collapseStream bulkOps

177+ body = Just $ encodeBulkOperations bulkOps

175178

176−collapseStream :: [BulkOperation] -> L.ByteString

177−collapseStream stream = collapsed where

178− blobs = intersperse "\n" $ concat $ fmap getStreamChunk stream

179+encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString

180+encodeBulkOperations stream = collapsed where

181+ blobs = fmap encodeBulkOperation stream

179182 mashedTaters = mash (mempty :: Builder) blobs

180183 collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")

181184

182−mash :: Builder -> [L.ByteString] -> Builder

183−mash = foldl' (\b x -> mappend b (lazyByteString x))

185+mash :: Builder -> V.Vector L.ByteString -> Builder

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

184187

185−mkMetadataValue :: Text -> String -> String -> String -> Value

186−mkMetadataValue operation indexName mappingName docId =

188+mkBulkStreamValue :: Text -> String -> String -> String -> Value

189+mkBulkStreamValue operation indexName mappingName docId =

187190 object [operation .=

188191 object [ "_index" .= indexName

189192 , "_type" .= mappingName

190193 , "_id" .= docId]]

191194

192−getStreamChunk :: BulkOperation -> [L.ByteString]

193−getStreamChunk (BulkIndex (IndexName indexName)

195+encodeBulkOperation :: BulkOperation -> L.ByteString

196+encodeBulkOperation (BulkIndex (IndexName indexName)

194197 (MappingName mappingName)

195− (DocId docId) value) = blob where

196− metadata = mkMetadataValue "index" indexName mappingName docId

197− blob = [encode metadata, encode value]

198+ (DocId docId) value) = blob

199+ where metadata = mkBulkStreamValue "index" indexName mappingName docId

200+ blob = encode metadata `mappend` "\n" `mappend` encode value

198201

199−getStreamChunk (BulkCreate (IndexName indexName)

202+encodeBulkOperation (BulkCreate (IndexName indexName)

200203 (MappingName mappingName)

201− (DocId docId) value) = blob where

202− metadata = mkMetadataValue "create" indexName mappingName docId

203− blob = [encode metadata, encode value]

204+ (DocId docId) value) = blob

205+ where metadata = mkBulkStreamValue "create" indexName mappingName docId

206+ blob = encode metadata `mappend` "\n" `mappend` encode value

204207

205−getStreamChunk (BulkDelete (IndexName indexName)

208+encodeBulkOperation (BulkDelete (IndexName indexName)

206209 (MappingName mappingName)

207− (DocId docId)) = blob where

208− metadata = mkMetadataValue "delete" indexName mappingName docId

209− blob = [encode metadata]

210+ (DocId docId)) = blob

211+ where metadata = mkBulkStreamValue "delete" indexName mappingName docId

212+ blob = encode metadata

210213

211−getStreamChunk (BulkUpdate (IndexName indexName)

214+encodeBulkOperation (BulkUpdate (IndexName indexName)

212215 (MappingName mappingName)

213− (DocId docId) value) = blob where

214− metadata = mkMetadataValue "update" indexName mappingName docId

215− doc = object ["doc" .= value]

216− blob = [encode metadata, encode doc]

216+ (DocId docId) value) = blob

217+ where metadata = mkBulkStreamValue "update" indexName mappingName docId

218+ doc = object ["doc" .= value]

219+ blob = encode metadata `mappend` "\n" `mappend` encode doc

220+

217221

218222getDocument :: Server -> IndexName -> MappingName

219223 -> DocId -> IO Reply

@@ -246,11 +250,10 @@ searchByType (Server server) (IndexName indexName)

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

247251

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

249−mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10

253+mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 0

250254

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

252−mkAggregateSearch query aggregations = Search query Nothing Nothing (Just aggregations) Nothing False 0 0

253−

256+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False 0 0

254257

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

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

Database/Bloodhound/Types.hs+18−16

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

11{-# LANGUAGE DeriveGeneric #-}

23{-# LANGUAGE RecordWildCards #-}

45{-| Data types for describing actions and data structures performed to interact

@@ -175,14 +176,13 @@ module Database.Bloodhound.Types

175176 , HighlightTag(..)

176177 , HitHighlight

177178

178− , TermsResult

179− , DateHistogramResult

179+ , TermsResult(..)

180+ , DateHistogramResult(..)

180181 ) where

181182

182183import Control.Applicative

183184import Data.Aeson

184−import Data.Aeson.Types (Pair (..), emptyObject,

185− parseMaybe)

185+import Data.Aeson.Types (Pair, emptyObject, parseMaybe)

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

187187import Data.List (nub)

188188import Data.List.NonEmpty (NonEmpty (..))

@@ -1061,7 +1061,7 @@ data ExecutionHint = Ordinals

10611061 | GlobalOrdinals

10621062 | GlobalOrdinalsHash

10631063 | GlobalOrdinalsLowCardinality

1064− | Map deriving(Eq, Show)

1064+ | Map deriving (Eq, Show)

10651065

10661066data TimeInterval = Weeks

10671067 | Days

@@ -1153,7 +1153,7 @@ instance Show TimeInterval where

11531153 show Seconds = "s"

11541154

11551155instance ToJSON Aggregation where

1156− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint aggs)) =

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

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

11581158 "include" .= toJSON include,

11591159 "exclude" .= toJSON exclude,

@@ -1164,11 +1164,11 @@ instance ToJSON Aggregation where

11641164 "collect_mode" .= toJSON collectMode,

11651165 "execution_hint" .= toJSON executionHint

11661166 ],

1167− "aggs" .= toJSON aggs ]

1167+ "aggs" .= toJSON termAggs ]

11681168 where

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

11701170

1171− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset aggs)) =

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

11721172 omitNulls ["date_histogram" .= omitNulls [ "field" .= toJSON field,

11731173 "interval" .= toJSON interval,

11741174 "format" .= toJSON format,

@@ -1177,7 +1177,7 @@ instance ToJSON Aggregation where

11771177 "pre_offset" .= toJSON preOffset,

11781178 "post_offset" .= toJSON postOffset

11791179 ],

1180− "aggs" .= toJSON aggs ]

1180+ "aggs" .= toJSON dateHistoAggs ]

11811181

11821182type AggregationResults = M.Map Text Value

11831183

@@ -1226,6 +1226,7 @@ instance FromJSON TermsResult where

12261226 v .: "key" <*>

12271227 v .: "doc_count" <*>

12281228 v .:? "aggregations"

1229+ parseJSON _ = mempty

12291230

12301231instance FromJSON DateHistogramResult where

12311232 parseJSON (Object v) = DateHistogramResult <$>

@@ -1233,6 +1234,7 @@ instance FromJSON DateHistogramResult where

12331234 v .:? "key_as_string" <*>

12341235 v .: "doc_count" <*>

12351236 v .:? "aggregations"

1237+ parseJSON _ = mempty

12361238

12371239instance Monoid Filter where

12381240 mempty = IdentityFilter

@@ -1317,11 +1319,11 @@ instance ToJSON Filter where

13171319 toJSON (RangeFilter (FieldName fieldName) (Left halfRange) rangeExecution cache) =

13181320 object ["range" .=

13191321 object [fieldName .=

1320− object [key .= val]

1322+ object [rqFKey .= rqFVal]

13211323 , "execution" .= toJSON rangeExecution

13221324 , "_cache" .= cache]]

13231325 where

1324− (key, val) = halfRangeToKV halfRange

1326+ (rqFKey, rqFVal) = halfRangeToKV halfRange

13251327

13261328 toJSON (RangeFilter (FieldName fieldName) (Right range) rangeExecution cache) =

13271329 object ["range" .=

@@ -1535,8 +1537,8 @@ instance ToJSON RangeQuery where

15351537 toJSON (RangeQuery (FieldName fieldName) (Left halfRange) boost) =

15361538 object [ fieldName .= conjoined ]

15371539 where conjoined = [ "boost" .= toJSON boost

1538− , key .= val ]

1539− (key, val) = halfRangeToKV halfRange

1540+ , rqKey .= rqVal ]

1541+ (rqKey, rqVal) = halfRangeToKV halfRange

15401542

15411543

15421544instance ToJSON PrefixQuery where

@@ -1827,16 +1829,17 @@ instance (FromJSON a) => FromJSON (EsResult a) where

18271829

18281830

18291831instance ToJSON Search where

1830− toJSON (Search query sFilter sort aggs highlight sTrackSortScores sFrom sSize) =

1832+ toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize) =

18311833 omitNulls [ "query" .= query

18321834 , "filter" .= sFilter

18331835 , "sort" .= sort

1834− , "aggregations" .= aggs

1836+ , "aggregations" .= searchAggs

18351837 , "highlight" .= highlight

18361838 , "from" .= sFrom

18371839 , "size" .= sSize

18381840 , "track_scores" .= sTrackSortScores]

18391841

1842+

18401843instance ToJSON FieldHighlight where

18411844 toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =

18421845 object [ fName .= fSettings ]

@@ -1918,7 +1921,6 @@ highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre

19181921 , "post_tags" .= post]

19191922highlightTagToPairs Nothing = []

19201923

1921−

19221924instance ToJSON SortSpec where

19231925 toJSON (DefaultSortSpec

19241926 (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped

LICENSE+8−17

@@ -1,21 +1,12 @@

1−The MIT License (MIT)

3−Copyright (c) <2014> <Chris Allen>

4+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

5−Permission is hereby granted, free of charge, to any person obtaining a copy

6−of this software and associated documentation files (the "Software"), to deal

7−in the Software without restriction, including without limitation the rights

8−to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

9−copies of the Software, and to permit persons to whom the Software is

10−furnished to do so, subject to the following conditions:

6+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

117

12−The above copyright notice and this permission notice shall be included in

13−all copies or substantial portions of the Software.

8+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

149

15−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

16−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

17−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

18−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

19−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

20−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN

21−THE SOFTWARE.

10+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

11+

12+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.org+42−1

@@ -7,6 +7,9 @@

77#+CAPTION: Build Status

88[[https://travis-ci.org/bitemyapp/bloodhound][https://travis-ci.org/bitemyapp/bloodhound.svg]]

10+#+CAPTION: Hackage version

11+[[https://budueba.com/hackage/bloodhound]]

12+

1013* Elasticsearch client and query DSL for Haskell

1114

1215** Why?

@@ -17,6 +20,8 @@ Search doesn't have to be hard. Let the dog do it.

1720

1821"Bloodhound makes Elasticsearch almost tolerable!" - Almost-gruntled user

1922

23+"ES is a nightmare but Bloodhound at least makes it tolerable." - Same user, later opinion.

24+

2025** Version compatibility

2126

2227Elasticsearch >= 1.0 is recommended. Bloodhound mostly works with 0.9.x, but I don't recommend it if you expect everything to work. As of Bloodhound 0.3 all >=1.0 versions of Elasticsearch work.

@@ -45,6 +50,7 @@ http://hackage.haskell.org/package/bloodhound

4550-- the multi-line examples into your ghci REPL.

4651

4752:set -XDeriveGeneric

53+:{

4854import Database.Bloodhound

4955import Data.Aeson

5056import Data.Either (Either(..))

@@ -68,6 +74,7 @@ let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)

6874

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

7076response <- createIndex testServer defaultIndexSettings testIndex

77+:}

7178

7279#+END_SRC

7380

@@ -281,7 +288,7 @@ Right (Tweet {user = "bitemyapp"

281288

282289*** Bulk create, index

283290

284−#+BEGIN_SRC haskell

291+#+BEGIN_SRC haskell

285292

286293-- don't forget the imports and derive generic setting for ghci

287294-- at the beginning of the examples.

@@ -318,6 +325,40 @@ resp <- bulk testServer stream

318325

319326#+END_SRC

320327

328+*** Encoding individual bulk API operations

329+

330+#+BEGIN_SRC haskell

331+-- the following functions are exported in Bloodhound so

332+-- you can build up bulk operations yourself

333+encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString

334+encodeBulkOperation :: BulkOperation -> L.ByteString

335+

336+-- How to use the above:

337+data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)

338+instance FromJSON BulkTest

339+instance ToJSON BulkTest

340+

341+_ <- insertData

342+let firstTest = BulkTest "blah"

343+let secondTest = BulkTest "bloo"

344+let firstDoc = BulkIndex testIndex

345+ testMapping (DocId "2") (toJSON firstTest)

346+let secondDoc = BulkCreate testIndex

347+ testMapping (DocId "3") (toJSON secondTest)

348+let stream = V.fromList [firstDoc, secondDoc] :: V.Vector BulkOperation

349+

350+-- to encode yourself

351+let firstDocEncoded = encode firstDoc :: L.ByteString

352+

353+-- to encode a vector of bulk operations

354+let encodedOperations = encodeBulkOperations stream

355+

356+-- to insert into a particular server

357+-- bulk :: Server -> V.Vector BulkOperation -> IO Reply

358+_ <- bulk testServer stream

359+

360+#+END_SRC

361+

321362** Search

322363

323364*** Querying

bloodhound.cabal+1−1

@@ -3,7 +3,7 @@ version: 0.4.0.0

33synopsis: ElasticSearch client library for Haskell

44description: ElasticSearch made awesome for Haskell hackers

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

6−license: MIT

6+license: BSD3

77license-file: LICENSE

88author: Chris Allen

99maintainer: cma@bitemyapp.com

tests/tests.hs+5−4

@@ -6,7 +6,6 @@ module Main where

66import Control.Applicative

77import Control.Monad

88import Data.Aeson

9−import Data.Aeson.Types (parseMaybe)

109import Data.HashMap.Strict (fromList)

1110import Data.List (nub)

1211import Data.List.NonEmpty (NonEmpty (..))

@@ -60,10 +59,12 @@ es10 :: ServerVersion

6059es10 = ServerVersion 1 0 0

6160

6261serverBranch :: ServerVersion -> ServerVersion

63−serverBranch (ServerVersion maj min patch) = ServerVersion maj min 0

62+serverBranch (ServerVersion majorVer minorVer patchVer) =

63+ ServerVersion majorVer minorVer patchVer

6464

6565mkServerVersion :: [Int] -> Maybe ServerVersion

66−mkServerVersion [maj, min, patch] = Just (ServerVersion maj min patch)

66+mkServerVersion [majorVer, minorVer, patchVer] =

67+ Just (ServerVersion majorVer minorVer patchVer)

6768mkServerVersion _ = Nothing

6869

6970getServerVersion :: Server -> IO (Maybe ServerVersion)

@@ -246,7 +247,7 @@ main = hspec $ do

246247 testMapping (DocId "2") (toJSON firstTest)

247248 let secondDoc = BulkCreate testIndex

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

249− let stream = [firstDoc, secondDoc]

250+ let stream = V.fromList [firstDoc, secondDoc]

250251 _ <- bulk testServer stream

251252 _ <- refreshIndex testServer testIndex

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