diff --git a/bloodhound.cabal b/bloodhound.cabal index 3f958df..aa52a4e 100644 --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -1,5 +1,5 @@ name: bloodhound -version: 0.4.0.2 +version: 0.5.0.0 synopsis: ElasticSearch client library for Haskell description: ElasticSearch made awesome for Haskell hackers homepage: https://github.com/bitemyapp/bloodhound diff --git a/changelog.md b/changelog.md index 7252cd4..9cb4c5e 100644 --- a/changelog.md +++ b/changelog.md @@ -1,9 +1,21 @@ +0.5.0.0 +=================== + +* Fixed and changed TermsQuery (This caused the major bump) + +* Removed benchmarks from travis.yml + +* Added doctests, examples for Database.Bloodhound.Client. Haddocks should be much nicer. + +* Various fixes, reformatting + 0.4.0.0 =================== * Term and date aggregation - thanks to Christopher Guiney! (@chrisguiney) Following three thanks to Liam Atkins (@latkins) + * omitNulls changed to exclude empty lists and null values * BoolQuery must/mustNot/Should changed from Maybe (Query|[Query]) to [Query] thanks to @latkins diff --git a/src/Database/Bloodhound/Client.hs b/src/Database/Bloodhound/Client.hs index 184e621..9ce025f 100644 --- a/src/Database/Bloodhound/Client.hs +++ b/src/Database/Bloodhound/Client.hs @@ -108,12 +108,22 @@ import Database.Bloodhound.Types --instance ToJSON BulkTest -- :} +-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount' +-- which rejects 'Int' values below 1 and above 1000. +-- +-- >>> mkShardCount 10 +-- Just (ShardCount 10) mkShardCount :: Int -> Maybe ShardCount mkShardCount n | n < 1 = Nothing | n > 1000 = Nothing | otherwise = Just (ShardCount n) +-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount' +-- which rejects 'Int' values below 1 and above 1000. +-- +-- >>> mkReplicaCount 10 +-- Just (ReplicaCount 10) mkReplicaCount :: Int -> Maybe ReplicaCount mkReplicaCount n | n < 1 = Nothing @@ -152,14 +162,17 @@ post = dispatch NHTM.methodPost -- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html -- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs +-- | 'getStatus' fetches the 'Status' of a 'Server' +-- +-- >>> getStatus testServer +-- 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"}) getStatus :: Server -> IO (Maybe Status) getStatus (Server server) = do request <- parseUrl $ joinPath [server] response <- withManager defaultManagerSettings $ httpLbs request return $ decode (responseBody response) --- | createIndex will create an index given a 'Server', --- 'IndexSettings', and an 'IndexName' +-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'. -- -- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex") -- >>> respIsTwoHunna response @@ -172,8 +185,7 @@ createIndex (Server server) indexSettings (IndexName indexName) = where url = joinPath [server, indexName] body = Just $ encode indexSettings --- | deleteIndex will delete an index given a 'Server', --- and an 'IndexName' +-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'. -- -- >>> response <- createIndex testServer defaultIndexSettings (IndexName "didimakeanindex") -- >>> response <- deleteIndex testServer (IndexName "didimakeanindex") @@ -196,6 +208,10 @@ existentialQuery url = do reply <- head url return (reply, respIsTwoHunna reply) +-- | 'indexExists' enables you to check if an index exists. Returns 'Bool' +-- in IO +-- +-- >>> exists <- indexExists testServer testIndex indexExists :: Server -> IndexName -> IO Bool indexExists (Server server) (IndexName indexName) = do (_, exists) <- existentialQuery url @@ -223,9 +239,17 @@ openOrCloseIndexes oci (Server server) (IndexName indexName) = where ociString = stringifyOCIndex oci url = joinPath [server, indexName, ociString] +-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at +-- http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html +-- +-- >>> reply <- openIndex testServer testIndex openIndex :: Server -> IndexName -> IO Reply openIndex = openOrCloseIndexes OpenIndex +-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at +-- http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html +-- +-- >>> reply <- closeIndex testServer testIndex closeIndex :: Server -> IndexName -> IO Reply closeIndex = openOrCloseIndexes CloseIndex @@ -361,6 +385,10 @@ getDocument (Server server) (IndexName indexName) (MappingName mappingName) (DocId docId) = get $ joinPath [server, indexName, mappingName, docId] +-- | 'documentExists' enables you to check if a document exists. Returns 'Bool' +-- in IO +-- +-- >>> exists <- documentExists testServer testIndex testMapping (DocId "1") documentExists :: Server -> IndexName -> MappingName -> DocId -> IO Bool documentExists (Server server) (IndexName indexName) @@ -372,27 +400,75 @@ documentExists (Server server) (IndexName indexName) dispatchSearch :: String -> Search -> IO Reply dispatchSearch url search = post url (Just (encode search)) +-- | 'searchAll', given a 'Search', will perform that search against all indexes +-- on an Elasticsearch server. Try to avoid doing this if it can be helped. +-- +-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing +-- >>> let search = mkSearch (Just query) Nothing +-- >>> reply <- searchAll testServer search searchAll :: Server -> Search -> IO Reply searchAll (Server server) = dispatchSearch url where url = joinPath [server, "_search"] +-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search +-- against all mappings within an index on an Elasticsearch server. +-- +-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing +-- >>> let search = mkSearch (Just query) Nothing +-- >>> reply <- searchByIndex testServer testIndex search searchByIndex :: Server -> IndexName -> Search -> IO Reply searchByIndex (Server server) (IndexName indexName) = dispatchSearch url where url = joinPath [server, indexName, "_search"] +-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that +-- search against a specific mapping within an index on an Elasticsearch server. +-- +-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing +-- >>> let search = mkSearch (Just query) Nothing +-- >>> reply <- searchByType testServer testIndex testMapping search searchByType :: Server -> IndexName -> MappingName -> Search -> IO Reply searchByType (Server server) (IndexName indexName) (MappingName mappingName) = dispatchSearch url where url = joinPath [server, indexName, mappingName, "_search"] +-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search' +-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update +-- syntax if you want to add things like aggregations or highlights while still using +-- this helper function. +-- +-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing +-- >>> mkSearch (Just query) Nothing +-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = 0, size = 10} mkSearch :: Maybe Query -> Maybe Filter -> Search mkSearch query filter = Search query filter Nothing Nothing Nothing False 0 10 +-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for +-- the 'Query' and the 'Aggregation'. +-- +-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst } +-- >>> terms +-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing}) +-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms mkAggregateSearch :: Maybe Query -> Aggregations -> Search mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False 0 0 +-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for +-- the 'Query' and the 'Aggregation'. +-- +-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell") +-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing] +-- >>> let search = mkHighlightSearch (Just query) testHighlight mkHighlightSearch :: Maybe Query -> Highlights -> Search mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False 0 10 +-- | 'pageSearch' is a helper function that takes a search and assigns the page from and to +-- fields for the search. +-- +-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell") +-- >>> let search = mkSearch (Just query) Nothing +-- >>> search +-- 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} +-- >>> pageSearch 10 100 search +-- 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} pageSearch :: Int -> Int -> Search -> Search pageSearch pageFrom pageSize search = search { from = pageFrom, size = pageSize } diff --git a/src/Database/Bloodhound/Types.hs b/src/Database/Bloodhound/Types.hs index 714badd..a684ceb 100644 --- a/src/Database/Bloodhound/Types.hs +++ b/src/Database/Bloodhound/Types.hs @@ -196,7 +196,7 @@ import Data.Aeson import Data.Aeson.Types (Pair, emptyObject, parseMaybe) import qualified Data.ByteString.Lazy.Char8 as L import Data.List (nub) -import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty (NonEmpty(..), toList) import qualified Data.Map.Strict as M import Data.Monoid import Data.Text (Text) @@ -598,7 +598,7 @@ data HighlightTag = TagSchema Text data Query = TermQuery Term (Maybe Boost) - | TermsQuery [Term] MinimumMatch + | TermsQuery (NonEmpty Term) | QueryMatchQuery MatchQuery | QueryMultiMatchQuery MultiMatchQuery | QueryBoolQuery BoolQuery @@ -1380,12 +1380,12 @@ instance ToJSON Query where boosted = maybe [] (return . ("boost" .=)) boost merged = mappend base boosted - toJSON (TermsQuery terms termsQueryMinimumMatch) = + toJSON (TermsQuery terms) = object [ "terms" .= object conjoined ] - where conjoined = - [ "tags" .= fmap toJSON terms - , "minimum_should_match" .= toJSON termsQueryMinimumMatch ] - + where conjoined = [ getTermsField terms .= + fmap (toJSON . getTermValue) (toList terms)] + getTermsField ((Term f _ ) :| _) = f + getTermValue (Term _ v) = v toJSON (IdsQuery idsQueryMappingName docIds) = object [ "ids" .= object conjoined ] where conjoined = [ "type" .= toJSON idsQueryMappingName diff --git a/tests/tests.hs b/tests/tests.hs index 9f1f14b..f2fe5bc 100644 --- a/tests/tests.hs +++ b/tests/tests.hs @@ -7,9 +7,10 @@ module Main where import Control.Applicative import Control.Monad import Data.Aeson -import Data.HashMap.Strict (fromList) +import qualified Data.HashMap.Strict as HM import Data.List (nub) import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M import Data.Text (Text) import qualified Data.Text as T @@ -269,6 +270,14 @@ main = hspec $ do myTweet <- searchTweet search myTweet `shouldBe` Right exampleTweet + it "returns document for terms query and identity filter" $ do + _ <- insertData + let query = TermsQuery (NE.fromList [(Term "user" "bitemyapp")]) + let filter = IdentityFilter <&&> IdentityFilter + let search = mkSearch (Just query) (Just filter) + myTweet <- searchTweet search + myTweet `shouldBe` Right exampleTweet + it "returns document for match query" $ do _ <- insertData let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp") @@ -542,19 +551,19 @@ main = hspec $ do it "checks that omitNulls drops list elements when it should" $ let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int])) , "test2" .= (toJSON ("some value" :: Text))] - in dropped `shouldBe` Object (fromList [("test2", String "some value")]) + in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")]) it "checks that omitNulls doesn't drop list elements when it shouldn't" $ let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int])) , "test2" .= (toJSON ("some value" :: Text))] - in notDropped `shouldBe` Object (fromList [ ("test1", Array (V.fromList [Number 1.0])) + in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0])) , ("test2", String "some value")]) it "checks that omitNulls drops non list elements when it should" $ let dropped = omitNulls $ [ "test1" .= (toJSON Null) , "test2" .= (toJSON ("some value" :: Text))] - in dropped `shouldBe` Object (fromList [("test2", String "some value")]) + in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")]) it "checks that omitNulls doesn't drop non list elements when it shouldn't" $ let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int)) , "test2" .= (toJSON ("some value" :: Text))] - in notDropped `shouldBe` Object (fromList [ ("test1", Number 1.0) + in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0) , ("test2", String "some value")])