git.iko.soy/typeable/bloodhound
on master help sign in
crazy test error
3908ca6Chris Allen
Database/Bloodhound/Client.hs+101−28
compare with master
unifiedsplit
@@ -10,7 +10,21 @@ module Database.Bloodhound.Client
10 , getDocument
10 , getDocument
11 , documentExists
11 , documentExists
12 , deleteDocument
12 , deleteDocument
13+ , Reply(..)
13 , EsResult(..)
14 , EsResult(..)
15+ , Query(..)
16+ , Search(..)
17+ , searchAll
18+ , searchByIndex
19+ , searchByType
20+ , SearchResult(..)
21+ , SearchHits(..)
22+ , ShardResult(..)
23+ , Hit(..)
24+ , Filter(..)
25+ , Seminearring(..)
26+ , BoolMatch(..)
27+ , Term(..)
14 )
28 )
15 where
29 where
16
30
@@ -230,6 +244,29 @@ documentExists (Server server) indexName mappingName docId = do
230 return exists where
244 return exists where
231 url = joinPath [server, indexName, mappingName, docId]
245 url = joinPath [server, indexName, mappingName, docId]
232
246
247+
248+dispatchSearch :: String -> Search -> IO Reply
249+dispatchSearch url search = dispatch url NHTM.methodPost (Just (encode search))
250+
251+searchAll :: Server -> Search -> IO Reply
252+searchAll (Server server) search = dispatchSearch url search where
253+ url = joinPath [server, "_search"]
254+
255+searchByIndex :: Server -> IndexName -> Search -> IO Reply
256+searchByIndex (Server server) indexName search = dispatchSearch url search where
257+ url = joinPath [server, indexName, "_search"]
258+
259+searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply
260+searchByType (Server server) indexName mappingName search = dispatchSearch url search where
261+ url = joinPath [server, indexName, mappingName, "_search"]
262+
263+data Search = Search { queryBody :: Maybe Query
264+ , filterBody :: Maybe Filter } deriving (Show)
265+
266+instance ToJSON Search where
267+ toJSON (Search query filters) = object [--"query" .= fmap toJSON query,
268+ "filter" .= fmap toJSON filters]
269+
233type QueryString = Text
270type QueryString = Text
234-- status:active
271-- status:active
235-- author:"John Smith"
272-- author:"John Smith"
@@ -244,6 +281,9 @@ newtype TieBreaker = TieBreaker Int deriving (Show)
244data QueryField = DefaultField Text
281data QueryField = DefaultField Text
245 | Fields [Text] DisMax TieBreaker deriving (Show)
282 | Fields [Text] DisMax TieBreaker deriving (Show)
246
283
284+-- this is will go away later
285+type Query = QueryStringQuery
286+
247data QueryStringQuery =
287data QueryStringQuery =
248 QueryStringQuery { query :: QueryString
288 QueryStringQuery { query :: QueryString
249 -- default _all
289 -- default _all
@@ -291,7 +331,7 @@ defaultCache = False
291data Filter = AndFilter [Filter] Cache
331data Filter = AndFilter [Filter] Cache
292 | OrFilter [Filter] Cache
332 | OrFilter [Filter] Cache
293 | IdentityFilter
333 | IdentityFilter
294− | BoolFilter BoolMatch Cache
334+ | BoolFilter BoolMatch
295 | ExistsFilter FieldName -- always cached
335 | ExistsFilter FieldName -- always cached
296 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache
336 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache
297 | GeoDistanceFilter GeoConstraint Distance Cache
337 | GeoDistanceFilter GeoConstraint Distance Cache
@@ -325,9 +365,8 @@ instance ToJSON Filter where
325 toJSON (ExistsFilter fieldName) =
365 toJSON (ExistsFilter fieldName) =
326 object ["exists" .= object
366 object ["exists" .= object
327 ["field" .= fieldName]]
367 ["field" .= fieldName]]
328− toJSON (BoolFilter boolMatch cache) =
368+ toJSON (BoolFilter boolMatch) =
329− object ["bool" .= toJSON boolMatch
369+ object ["bool" .= toJSON boolMatch]
330− , "_cache" .= cache]
331
370
332data Term = Term { termField :: Text
371data Term = Term { termField :: Text
333 , termValue :: Text } deriving (Show)
372 , termValue :: Text } deriving (Show)
@@ -336,14 +375,17 @@ instance ToJSON Term where
336 toJSON (Term field value) = object ["term" .= object
375 toJSON (Term field value) = object ["term" .= object
337 [field .= value]]
376 [field .= value]]
338
377
339−data BoolMatch = MustMatch Term
378+data BoolMatch = MustMatch Term Cache
340− | MustNotMatch Term
379+ | MustNotMatch Term Cache
341− | ShouldMatch [Term] deriving (Show)
380+ | ShouldMatch [Term] Cache deriving (Show)
342
381
343instance ToJSON BoolMatch where
382instance ToJSON BoolMatch where
344− toJSON (MustMatch term) = object ["must" .= toJSON term]
383+ toJSON (MustMatch term cache) = object ["must" .= toJSON term,
384+ "_cache" .= cache]
345− toJSON (MustNotMatch term) = object ["must_not" .= toJSON term]
385+ toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
386+ "_cache" .= cache]
346− toJSON (ShouldMatch terms) = object ["should" .= fmap toJSON terms]
387+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
388+ "_cache" .= cache]
347
389
348-- "memory" or "indexed"
390-- "memory" or "indexed"
349data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Show)
391data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Show)
@@ -383,27 +425,58 @@ data Distance =
383 Distance { coefficient :: Double
425 Distance { coefficient :: Double
384 , unit :: DistanceUnits } deriving (Show)
426 , unit :: DistanceUnits } deriving (Show)
385
427
386−data FromJSON a => SearchResults a =
428+data FromJSON a => SearchResult a =
387− SearchResults { took :: Int
429+ SearchResult { took :: Int
388− , timedOut :: Bool
430+ , timedOut :: Bool
389− , shards :: ShardResults
431+ , shards :: ShardResult
390− , searchHits :: SearchHits a } deriving (Show)
432+ , searchHits :: SearchHits a } deriving (Show)
391
433
392type Score = Double
434type Score = Double
393
435
394data FromJSON a => SearchHits a =
436data FromJSON a => SearchHits a =
395 SearchHits { hitsTotal :: Int
437 SearchHits { hitsTotal :: Int
396 , maxScore :: Score
438 , maxScore :: Score
397− , hits :: [Hits a] } deriving (Show)
439+ , hits :: [Hit a] } deriving (Show)
398−
440+
399−data FromJSON a => Hits a =
441+data FromJSON a => Hit a =
400− Hits { hitsIndex :: IndexName
442+ Hit { hitIndex :: IndexName
401− , hitsType :: MappingName
443+ , hitType :: MappingName
402− , hitDocumentID :: DocumentID
444+ , hitDocumentID :: DocumentID
403− , hitScore :: Score
445+ , hitScore :: Score
404− , hitSource :: a } deriving (Show)
446+ , hitSource :: a } deriving (Show)
405−
447+
406−data ShardResults =
448+data ShardResult =
407− ShardResults { shardTotal :: Int
449+ ShardResult { shardTotal :: Int
408− , shardsSuccessful :: Int
450+ , shardsSuccessful :: Int
409− , shardsFailed :: Int } deriving (Show)
451+ , shardsFailed :: Int } deriving (Show, Generic)
452+
453+instance (FromJSON a, ToJSON a) => FromJSON (SearchResult a) where
454+ parseJSON (Object v) = SearchResult <$>
455+ v .: "took" <*>
456+ v .: "timed_out" <*>
457+ v .: "_shards" <*>
458+ v .: "hits"
459+ parseJSON _ = empty
460+
461+instance (FromJSON a, ToJSON a) => FromJSON (SearchHits a) where
462+ parseJSON (Object v) = SearchHits <$>
463+ v .: "total" <*>
464+ v .: "max_score" <*>
465+ v .: "hits"
466+ parseJSON _ = empty
467+
468+instance (FromJSON a, ToJSON a) => FromJSON (Hit a) where
469+ parseJSON (Object v) = Hit <$>
470+ v .: "_index" <*>
471+ v .: "_type" <*>
472+ v .: "_id" <*>
473+ v .: "_score" <*>
474+ v .: "_source"
475+ parseJSON _ = empty
476+
477+instance FromJSON ShardResult where
478+ parseJSON (Object v) = ShardResult <$>
479+ v .: "total" <*>
480+ v .: "successful" <*>
481+ v .: "failed"
482+ parseJSON _ = empty
bloodhound.cabal+1
@@ -38,6 +38,7 @@ library
38 default-language: Haskell2010
38 default-language: Haskell2010
39
39
40test-suite tests
40test-suite tests
41+ default-extensions: OverloadedStrings
41 type: exitcode-stdio-1.0
42 type: exitcode-stdio-1.0
42 main-is: tests.hs
43 main-is: tests.hs
43 -- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N
44 -- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N
tests/tests.hs+37−18
@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
1+{-# LANGUAGE DeriveGeneric #-}
2
2
3module Main where
3module Main where
4
4
@@ -22,9 +22,9 @@ validateStatus resp expected = (NHTS.statusCode $ responseStatus resp) `shouldBe
22createExampleIndex = createIndex testServer defaultIndexSettings testIndex
22createExampleIndex = createIndex testServer defaultIndexSettings testIndex
23deleteExampleIndex = deleteIndex testServer testIndex
23deleteExampleIndex = deleteIndex testServer testIndex
24
24
25−data Tweet = Tweet { user :: Text
25+data Tweet = Tweet { user :: Text
26 , postDate :: UTCTime
26 , postDate :: UTCTime
27− , message :: Text }
27+ , message :: Text }
28 deriving (Eq, Generic, Show)
28 deriving (Eq, Generic, Show)
29
29
30instance ToJSON Tweet
30instance ToJSON Tweet
@@ -36,24 +36,43 @@ exampleTweet = Tweet { user = "bitemyapp"
36 (secondsToDiffTime 10)
36 (secondsToDiffTime 10)
37 , message = "Use haskell!" }
37 , message = "Use haskell!" }
38
38
39+insertData :: IO ()
40+insertData = do
41+ let encoded = encode exampleTweet
42+ _ <- deleteExampleIndex
43+ created <- createExampleIndex
44+ docCreated <- indexDocument (Server "http://localhost:9200") "twitter" "tweet" exampleTweet "1"
45+ return ()
46+
47+queryTweet :: IO (Either String Tweet)
48+queryTweet = do
49+ let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
50+ <||> IdentityFilter
51+ let search = Search Nothing (Just queryFilter)
52+ reply <- searchByIndex testServer "twitter" search
53+ let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
54+ let myTweet = fmap (hitSource . head . hits . searchHits) result
55+ return myTweet
56+
39main :: IO ()
57main :: IO ()
40main = hspec $ do
58main = hspec $ do
41− describe "index create/delete API" $ do
59+ -- describe "index create/delete API" $ do
42− it "creates and then deletes the requested index" $ do
60+ -- it "creates and then deletes the requested index" $ do
43− -- priming state.
61+ -- -- priming state.
44− _ <- deleteExampleIndex
62+ -- _ <- deleteExampleIndex
45− resp <- createExampleIndex
63+ -- resp <- createExampleIndex
46− deleteResp <- deleteExampleIndex
64+ -- deleteResp <- deleteExampleIndex
47− validateStatus resp 200
65+ -- validateStatus resp 200
48− validateStatus deleteResp 200
66+ -- validateStatus deleteResp 200
67+
49 describe "document API" $ do
68 describe "document API" $ do
50 it "indexes, gets, and then deletes the generated document" $ do
69 it "indexes, gets, and then deletes the generated document" $ do
51− let tweet = exampleTweet
52− let encoded = encode tweet
53− _ <- deleteExampleIndex
54− created <- createExampleIndex
55− docCreated <- indexDocument (Server "http://localhost:9200") "twitter" "tweet" tweet "1"
56 docInserted <- getDocument (Server "http://localhost:9200") "twitter" "tweet" "1"
70 docInserted <- getDocument (Server "http://localhost:9200") "twitter" "tweet" "1"
57 let newTweet = eitherDecode (responseBody docInserted) :: Either String (EsResult Tweet)
71 let newTweet = eitherDecode (responseBody docInserted) :: Either String (EsResult Tweet)
58− deleted <- deleteExampleIndex
59− Right tweet `shouldBe` fmap _source newTweet
72+ fmap _source newTweet `shouldBe` Right exampleTweet
73+
74+ describe "document filtering" $ do
75+ it "returns documents expected from composed filters" $ do
76+ _ <- insertData
77+ myTweet <- queryTweet
78+ myTweet `shouldBe` Right exampleTweet