git.iko.soy/typeable/bloodhound
on master help sign in
crazy test error
commit3908ca69e42a89eda4aff497165a0ab0f4111006 authorChris Allen <cma@bitemyapp.com> dateThu 10 Apr 2014, 00:25 (13 years ago) parentcdc262f
3 files changed+139−46
compare with master
unifiedsplit
Database/Bloodhound/Client.hs+101−28 bloodhound.cabal+1 tests/tests.hs+37−18
Database/Bloodhound/Client.hs+101−28
@@ -10,7 +10,21 @@ module Database.Bloodhound.Client
1010 , getDocument
1111 , documentExists
1212 , deleteDocument
13+ , Reply(..)
1314 , 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(..)
1428 )
1529 where
1630
@@ -230,6 +244,29 @@ documentExists (Server server) indexName mappingName docId = do
230244 return exists where
231245 url = joinPath [server, indexName, mappingName, docId]
232246
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+
233270type QueryString = Text
234271-- status:active
235272-- author:"John Smith"
@@ -244,6 +281,9 @@ newtype TieBreaker = TieBreaker Int deriving (Show)
244281data QueryField = DefaultField Text
245282 | Fields [Text] DisMax TieBreaker deriving (Show)
246283
284+-- this is will go away later
285+type Query = QueryStringQuery
286+
247287data QueryStringQuery =
248288 QueryStringQuery { query :: QueryString
249289 -- default _all
@@ -291,7 +331,7 @@ defaultCache = False
291331data Filter = AndFilter [Filter] Cache
292332 | OrFilter [Filter] Cache
293333 | IdentityFilter
294− | BoolFilter BoolMatch Cache
334+ | BoolFilter BoolMatch
295335 | ExistsFilter FieldName -- always cached
296336 | GeoBoundingBoxFilter GeoBoundingBoxConstraint GeoFilterType Cache
297337 | GeoDistanceFilter GeoConstraint Distance Cache
@@ -325,9 +365,8 @@ instance ToJSON Filter where
325365 toJSON (ExistsFilter fieldName) =
326366 object ["exists" .= object
327367 ["field" .= fieldName]]
328− toJSON (BoolFilter boolMatch cache) =
329− object ["bool" .= toJSON boolMatch
330− , "_cache" .= cache]
368+ toJSON (BoolFilter boolMatch) =
369+ object ["bool" .= toJSON boolMatch]
331370
332371data Term = Term { termField :: Text
333372 , termValue :: Text } deriving (Show)
@@ -336,14 +375,17 @@ instance ToJSON Term where
336375 toJSON (Term field value) = object ["term" .= object
337376 [field .= value]]
338377
339−data BoolMatch = MustMatch Term
340− | MustNotMatch Term
341− | ShouldMatch [Term] deriving (Show)
378+data BoolMatch = MustMatch Term Cache
379+ | MustNotMatch Term Cache
380+ | ShouldMatch [Term] Cache deriving (Show)
342381
343382instance ToJSON BoolMatch where
344− toJSON (MustMatch term) = object ["must" .= toJSON term]
345− toJSON (MustNotMatch term) = object ["must_not" .= toJSON term]
346− toJSON (ShouldMatch terms) = object ["should" .= fmap toJSON terms]
383+ toJSON (MustMatch term cache) = object ["must" .= toJSON term,
384+ "_cache" .= cache]
385+ toJSON (MustNotMatch term cache) = object ["must_not" .= toJSON term,
386+ "_cache" .= cache]
387+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
388+ "_cache" .= cache]
347389
348390-- "memory" or "indexed"
349391data GeoFilterType = GeoFilterMemory | GeoFilterIndexed deriving (Show)
@@ -383,27 +425,58 @@ data Distance =
383425 Distance { coefficient :: Double
384426 , unit :: DistanceUnits } deriving (Show)
385427
386−data FromJSON a => SearchResults a =
387− SearchResults { took :: Int
388− , timedOut :: Bool
389− , shards :: ShardResults
390− , searchHits :: SearchHits a } deriving (Show)
428+data FromJSON a => SearchResult a =
429+ SearchResult { took :: Int
430+ , timedOut :: Bool
431+ , shards :: ShardResult
432+ , searchHits :: SearchHits a } deriving (Show)
391433
392434type Score = Double
393435
394436data FromJSON a => SearchHits a =
395437 SearchHits { hitsTotal :: Int
396438 , maxScore :: Score
397− , hits :: [Hits a] } deriving (Show)
398−
399−data FromJSON a => Hits a =
400− Hits { hitsIndex :: IndexName
401− , hitsType :: MappingName
402− , hitDocumentID :: DocumentID
403− , hitScore :: Score
404− , hitSource :: a } deriving (Show)
405−
406−data ShardResults =
407− ShardResults { shardTotal :: Int
408− , shardsSuccessful :: Int
409− , shardsFailed :: Int } deriving (Show)
439+ , hits :: [Hit a] } deriving (Show)
440+
441+data FromJSON a => Hit a =
442+ Hit { hitIndex :: IndexName
443+ , hitType :: MappingName
444+ , hitDocumentID :: DocumentID
445+ , hitScore :: Score
446+ , hitSource :: a } deriving (Show)
447+
448+data ShardResult =
449+ ShardResult { shardTotal :: Int
450+ , shardsSuccessful :: Int
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
3838 default-language: Haskell2010
3939
4040test-suite tests
41+ default-extensions: OverloadedStrings
4142 type: exitcode-stdio-1.0
4243 main-is: tests.hs
4344 -- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N
tests/tests.hs+37−18
@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
1+{-# LANGUAGE DeriveGeneric #-}
22
33module Main where
44
@@ -22,9 +22,9 @@ validateStatus resp expected = (NHTS.statusCode $ responseStatus resp) `shouldBe
2222createExampleIndex = createIndex testServer defaultIndexSettings testIndex
2323deleteExampleIndex = deleteIndex testServer testIndex
2424
25−data Tweet = Tweet { user :: Text
25+data Tweet = Tweet { user :: Text
2626 , postDate :: UTCTime
27− , message :: Text }
27+ , message :: Text }
2828 deriving (Eq, Generic, Show)
2929
3030instance ToJSON Tweet
@@ -36,24 +36,43 @@ exampleTweet = Tweet { user = "bitemyapp"
3636 (secondsToDiffTime 10)
3737 , message = "Use haskell!" }
3838
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+
3957main :: IO ()
4058main = hspec $ do
41− describe "index create/delete API" $ do
42− it "creates and then deletes the requested index" $ do
43− -- priming state.
44− _ <- deleteExampleIndex
45− resp <- createExampleIndex
46− deleteResp <- deleteExampleIndex
47− validateStatus resp 200
48− validateStatus deleteResp 200
59+ -- describe "index create/delete API" $ do
60+ -- it "creates and then deletes the requested index" $ do
61+ -- -- priming state.
62+ -- _ <- deleteExampleIndex
63+ -- resp <- createExampleIndex
64+ -- deleteResp <- deleteExampleIndex
65+ -- validateStatus resp 200
66+ -- validateStatus deleteResp 200
67+
4968 describe "document API" $ do
5069 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"
5670 docInserted <- getDocument (Server "http://localhost:9200") "twitter" "tweet" "1"
5771 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