@@ -16,7 +16,8 @@
16module Database.Bloodhound.Client
16module Database.Bloodhound.Client
17 ( -- * Bloodhound client functions
17 ( -- * Bloodhound client functions
18 -- | The examples in this module assume the following code has been run.
18 -- | The examples in this module assume the following code has been run.
19− -- The :{ and :} will only work in GHCi.
19+ -- The :{ and :} will only work in GHCi. You'll only need the data types
20+ -- and typeclass instances for the functions that make use of them.
@@ -64,6 +65,7 @@ import Database.Bloodhound.Types
66-- >>> :set -XOverloadedStrings
67-- >>> :set -XOverloadedStrings
68+-- >>> :set -XDeriveGeneric
67-- >>> import Database.Bloodhound
69-- >>> import Database.Bloodhound
68-- >>> import Test.DocTest.Prop (assert)
70-- >>> import Test.DocTest.Prop (assert)
69-- >>> let testServer = (Server "http://localhost:9200")
71-- >>> let testServer = (Server "http://localhost:9200")
@@ -73,6 +75,9 @@ import Database.Bloodhound.Types
73-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
75-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
74-- >>> _ <- deleteIndex testServer testIndex
76-- >>> _ <- deleteIndex testServer testIndex
75-- >>> _ <- deleteMapping testServer testIndex testMapping
77-- >>> _ <- deleteMapping testServer testIndex testMapping
78+-- >>> import GHC.Generics
79+-- >>> import Data.Time.Calendar (Day (..))
80+-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
77--instance ToJSON TweetMapping where
82--instance ToJSON TweetMapping where
78-- toJSON TweetMapping =
83-- toJSON TweetMapping =
@@ -80,9 +85,29 @@ import Database.Bloodhound.Types
80-- object ["properties" .=
85-- object ["properties" .=
81-- object ["location" .=
86-- object ["location" .=
82-- object ["type" .= ("geo_point" :: Text)]]]]
87-- object ["type" .= ("geo_point" :: Text)]]]]
88+--data Location = Location { lat :: Double
89+-- , lon :: Double } deriving (Eq, Generic, Show)
90+--data Tweet = Tweet { user :: Text
91+-- , postDate :: UTCTime
94+-- , location :: Location } deriving (Eq, Generic, Show)
95+--exampleTweet = Tweet { user = "bitemyapp"
96+-- , postDate = UTCTime
97+-- (ModifiedJulianDay 55000)
98+-- (secondsToDiffTime 10)
99+-- , message = "Use haskell!"
101+-- , location = Location 40.12 (-71.34) }
102+--instance ToJSON Tweet
103+--instance FromJSON Tweet
104+--instance ToJSON Location
105+--instance FromJSON Location
106+--data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
107+--instance FromJSON BulkTest
108+--instance ToJSON BulkTest
86mkShardCount :: Int -> Maybe ShardCount
111mkShardCount :: Int -> Maybe ShardCount
87mkShardCount n
112mkShardCount n
88 | n < 1 = Nothing
113 | n < 1 = Nothing
@@ -160,8 +185,11 @@ deleteIndex :: Server -> IndexName -> IO Reply
160deleteIndex (Server server) (IndexName indexName) =
185deleteIndex (Server server) (IndexName indexName) =
161 delete $ joinPath [server, indexName]
186 delete $ joinPath [server, indexName]
188+statusCodeIs :: Int -> Reply -> Bool
189+statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
163respIsTwoHunna :: Reply -> Bool
191respIsTwoHunna :: Reply -> Bool
164−respIsTwoHunna resp = NHTS.statusCode (responseStatus resp) == 200
192+respIsTwoHunna = statusCodeIs 200
166existentialQuery :: String -> IO (Reply, Bool)
194existentialQuery :: String -> IO (Reply, Bool)
167existentialQuery url = do
195existentialQuery url = do
@@ -177,10 +205,8 @@ indexExists (Server server) (IndexName indexName) = do
177-- | 'refreshIndex' will force a refresh on an index. You must
205-- | 'refreshIndex' will force a refresh on an index. You must
178-- do this if you want to read what you wrote.
206-- do this if you want to read what you wrote.
180−-- >>> response <- createIndex testServer defaultIndexSettings testIndex
208+-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
181−-- >>> response <- refreshIndex testServer testIndex
209+-- >>> _ <- refreshIndex testServer testIndex
182−-- >>> respIsTwoHunna response
184refreshIndex :: Server -> IndexName -> IO Reply
210refreshIndex :: Server -> IndexName -> IO Reply
185refreshIndex (Server server) (IndexName indexName) =
211refreshIndex (Server server) (IndexName indexName) =
186 post url Nothing
212 post url Nothing
@@ -206,10 +232,10 @@ closeIndex = openOrCloseIndexes CloseIndex
206-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
232-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
207-- for documents in indexes.
233-- for documents in indexes.
209−-- >>> response <- createIndex testServer defaultIndexSettings testIndex
235+-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
210-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping
236-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping
211−-- >>> respIsTwoHunna resp
237+-- >>> print resp
212−-- True
238+-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
213putMapping :: ToJSON a => Server -> IndexName
239putMapping :: ToJSON a => Server -> IndexName
214 -> MappingName -> a -> IO Reply
240 -> MappingName -> a -> IO Reply
215putMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
241putMapping (Server server) (IndexName indexName) (MappingName mappingName) mapping =
@@ -220,18 +246,24 @@ putMapping (Server server) (IndexName indexName) (MappingName mappingName) mappi
220-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
246-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
221-- Mappings are schemas for documents in indexes.
247-- Mappings are schemas for documents in indexes.
223−-- >>> response <- createIndex testServer defaultIndexSettings testIndex
249+-- >>> _ <- createIndex testServer defaultIndexSettings testIndex
224−-- >>> resp <- putMapping testServer testIndex testMapping TweetMapping
250+-- >>> _ <- putMapping testServer testIndex testMapping TweetMapping
225−-- >>> respIsTwoHunna resp
227-- >>> resp <- deleteMapping testServer testIndex testMapping
251-- >>> resp <- deleteMapping testServer testIndex testMapping
228−-- >>> respIsTwoHunna resp
252+-- >>> print resp
229−-- True
253+-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
230deleteMapping :: Server -> IndexName -> MappingName -> IO Reply
254deleteMapping :: Server -> IndexName -> MappingName -> IO Reply
231deleteMapping (Server server) (IndexName indexName)
255deleteMapping (Server server) (IndexName indexName)
232 (MappingName mappingName) =
256 (MappingName mappingName) =
233 delete $ joinPath [server, indexName, mappingName, "_mapping"]
257 delete $ joinPath [server, indexName, mappingName, "_mapping"]
259+-- | 'indexDocument' is the primary way to save a single document in
260+-- Elasticsearch. The document itself is simply something we can
261+-- convert into a JSON 'Value'. The 'DocId' will function as the
262+-- primary key for the document.
264+-- >>> resp <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
266+-- 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}
235indexDocument :: ToJSON doc => Server -> IndexName -> MappingName
267indexDocument :: ToJSON doc => Server -> IndexName -> MappingName
236 -> doc -> DocId -> IO Reply
268 -> doc -> DocId -> IO Reply
237indexDocument (Server server) (IndexName indexName)
269indexDocument (Server server) (IndexName indexName)
@@ -240,17 +272,36 @@ indexDocument (Server server) (IndexName indexName)
240 where url = joinPath [server, indexName, mappingName, docId]
272 where url = joinPath [server, indexName, mappingName, docId]
241 body = Just (encode document)
273 body = Just (encode document)
275+-- | 'deleteDocument' is the primary way to delete a single document.
277+-- >>> _ <- deleteDocument testServer testIndex testMapping (DocId "1")
243deleteDocument :: Server -> IndexName -> MappingName
278deleteDocument :: Server -> IndexName -> MappingName
244 -> DocId -> IO Reply
279 -> DocId -> IO Reply
245deleteDocument (Server server) (IndexName indexName)
280deleteDocument (Server server) (IndexName indexName)
246 (MappingName mappingName) (DocId docId) =
281 (MappingName mappingName) (DocId docId) =
247 delete $ joinPath [server, indexName, mappingName, docId]
282 delete $ joinPath [server, indexName, mappingName, docId]
284+-- | 'bulk' uses Elasticsearch's bulk API at
285+-- http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html
286+-- to perform bulk operations. The 'BulkOperation' data type encodes the
287+-- index/update/delete/create operations. You pass a 'V.Vector' of 'BulkOperation's
288+-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
289+-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
291+-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
292+-- >>> _ <- bulk testServer stream
293+-- >>> _ <- refreshIndex testServer testIndex
249bulk :: Server -> V.Vector BulkOperation -> IO Reply
294bulk :: Server -> V.Vector BulkOperation -> IO Reply
250bulk (Server server) bulkOps = post url body where
295bulk (Server server) bulkOps = post url body where
251 url = joinPath [server, "_bulk"]
296 url = joinPath [server, "_bulk"]
252 body = Just $ encodeBulkOperations bulkOps
297 body = Just $ encodeBulkOperations bulkOps
299+-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
300+-- into an 'L.ByteString'
302+-- >>> let bulkOps = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
303+-- >>> encodeBulkOperations bulkOps
304+-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
254encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
305encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
255encodeBulkOperations stream = collapsed where
306encodeBulkOperations stream = collapsed where
256 blobs = fmap encodeBulkOperation stream
307 blobs = fmap encodeBulkOperation stream
@@ -267,6 +318,12 @@ mkBulkStreamValue operation indexName mappingName docId =
267 , "_type" .= mappingName
318 , "_type" .= mappingName
268 , "_id" .= docId]]
319 , "_id" .= docId]]
321+-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
322+-- into an 'L.ByteString'
324+-- >>> let bulkOp = BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))
325+-- >>> encodeBulkOperation bulkOp
326+-- "{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}"
270encodeBulkOperation :: BulkOperation -> L.ByteString
327encodeBulkOperation :: BulkOperation -> L.ByteString
271encodeBulkOperation (BulkIndex (IndexName indexName)
328encodeBulkOperation (BulkIndex (IndexName indexName)
272 (MappingName mappingName)
329 (MappingName mappingName)