@@ -1,5 +1,5 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE RecordWildCards #-}
4-------------------------------------------------------------------------------
4-------------------------------------------------------------------------------
@@ -39,6 +39,7 @@ module Database.Bloodhound.Client
39 , searchAll
39 , searchAll
40 , searchByIndex
40 , searchByIndex
41 , searchByType
41 , searchByType
42 , refreshIndex
43 , refreshIndex
43 , mkSearch
44 , mkSearch
44 , mkAggregateSearch
45 , mkAggregateSearch
@@ -171,6 +172,18 @@ joinPath ps = do
171 Server s <- bhServer <$> getBHEnv
172 Server s <- bhServer <$> getBHEnv
172 return $ joinPath' (s:ps)
173 return $ joinPath' (s:ps)
175+appendSearchTypeParam :: Text -> SearchType -> Text
176+appendSearchTypeParam originalUrl st = addQuery [(keyEq, Just stParams)] originalUrl
177+ where keyEq = "search_type="
179+ | st == SearchTypeDfsQueryThenFetch = "dfs_query_then_fetch"
180+ | st == SearchTypeCount = "count"
181+ | st == SearchTypeScan = "scan&scroll=1m"
182+ | st == SearchTypeQueryAndFetch = "query_and_fetch"
183+ | st == SearchTypeDfsQueryAndFetch = "dfs_query_and_fetch"
184+ -- used to catch 'SearchTypeQueryThenFetch', which is also the default
185+ | otherwise = "query_then_fetch"
174-- | Severely dumbed down query renderer. Assumes your data doesn't
187-- | Severely dumbed down query renderer. Assumes your data doesn't
175-- need any encoding
188-- need any encoding
176addQuery :: [(Text, Maybe Text)] -> Text -> Text
189addQuery :: [(Text, Maybe Text)] -> Text -> Text
@@ -180,11 +193,10 @@ addQuery q u = u <> rendered
180 T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
193 T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
181 prependQuestionMark = True
194 prependQuestionMark = True
184bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
196bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
185bindM2 f ma mb = join (f <$> ma <*> mb)
197bindM2 f ma mb = join (f <$> ma <*> mb)
187−-- | Convenience function that sets up a mananager and BHEnv and runs
199+-- | Convenience function that sets up a manager and BHEnv and runs
188-- the given set of bloodhound operations. Connections will be
200-- the given set of bloodhound operations. Connections will be
189-- pipelined automatically in accordance with the given manager
201-- pipelined automatically in accordance with the given manager
190-- settings in IO. If you've got your own monad transformer stack, you
202-- settings in IO. If you've got your own monad transformer stack, you
@@ -496,7 +508,8 @@ documentExists (IndexName indexName)
496 where url = joinPath [indexName, mappingName, docId]
508 where url = joinPath [indexName, mappingName, docId]
498dispatchSearch :: MonadBH m => Text -> Search -> m Reply
510dispatchSearch :: MonadBH m => Text -> Search -> m Reply
499−dispatchSearch url search = post url (Just (encode search))
511+dispatchSearch url search = post url' (Just (encode search))
512+ where url' = appendSearchTypeParam url (searchType search)
501-- | 'searchAll', given a 'Search', will perform that search against all indexes
514-- | 'searchAll', given a 'Search', will perform that search against all indexes
502-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
515-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
@@ -530,6 +543,40 @@ searchByType (IndexName indexName)
530 (MappingName mappingName) = bindM2 dispatchSearch url . return
543 (MappingName mappingName) = bindM2 dispatchSearch url . return
531 where url = joinPath [indexName, mappingName, "_search"]
544 where url = joinPath [indexName, mappingName, "_search"]
546+scanSearch' :: MonadBH m => Search -> m (Maybe ScrollId)
547+scanSearch' search = do
548+ let url = joinPath ["_search"]
549+ search' = search { searchType = SearchTypeScan }
550+ resp' <- bindM2 dispatchSearch url (return search')
551+ let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
552+ msid = maybe Nothing scrollId msr
555+scroll' :: (FromJSON a, MonadBH m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
556+scroll' Nothing = return ([], Nothing)
557+scroll' (Just sid) = do
558+ url <- joinPath ["_search/scroll?scroll=1m"]
559+ resp' <- post url (Just . L.fromStrict $ T.encodeUtf8 sid)
560+ let msr = decode' $ responseBody resp' :: FromJSON a => Maybe (SearchResult a)
562+ Just sr -> (hits $ searchHits sr, scrollId sr)
566+simpleAccumilator :: (FromJSON a, MonadBH m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
567+simpleAccumilator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
568+simpleAccumilator oldHits ([], _) = return (oldHits, Nothing)
569+simpleAccumilator oldHits (newHits, msid) = do
570+ (newHits', msid') <- scroll' msid
571+ simpleAccumilator (oldHits ++ newHits) (newHits', msid')
573+scanSearch :: (FromJSON a, MonadBH m) => Search -> m [Hit a]
574+scanSearch search = do
575+ msid <- scanSearch' search
576+ (hits, msid') <- scroll' msid
577+ (totalHits, _) <- simpleAccumilator [] (hits, msid')
533-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
580-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
534-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
581-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
535-- syntax if you want to add things like aggregations or highlights while still using
582-- syntax if you want to add things like aggregations or highlights while still using
@@ -537,9 +584,9 @@ searchByType (IndexName indexName)
538-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
585-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
539-- >>> mkSearch (Just query) Nothing
586-- >>> mkSearch (Just query) Nothing
540−-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, fields = Nothing, source = Nothing}
587+-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
541mkSearch :: Maybe Query -> Maybe Filter -> Search
588mkSearch :: Maybe Query -> Maybe Filter -> Search
542−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) Nothing Nothing
589+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
544-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
591-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
545-- the 'Query' and the 'Aggregation'.
592-- the 'Query' and the 'Aggregation'.
@@ -549,7 +596,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
549-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
596-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
550-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
597-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
551mkAggregateSearch :: Maybe Query -> Aggregations -> Search
598mkAggregateSearch :: Maybe Query -> Aggregations -> Search
552−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) Nothing Nothing
599+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
554-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
601-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
555-- the 'Query' and the 'Aggregation'.
602-- the 'Query' and the 'Aggregation'.
@@ -558,7 +605,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
558-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
605-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
559-- >>> let search = mkHighlightSearch (Just query) testHighlight
606-- >>> let search = mkHighlightSearch (Just query) testHighlight
560mkHighlightSearch :: Maybe Query -> Highlights -> Search
607mkHighlightSearch :: Maybe Query -> Highlights -> Search
561−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) Nothing Nothing
608+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
563-- | 'pageSearch' is a helper function that takes a search and assigns the from
610-- | 'pageSearch' is a helper function that takes a search and assigns the from
564-- and size fields for the search. The from parameter defines the offset
611-- and size fields for the search. The from parameter defines the offset
@@ -568,9 +615,9 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing
568-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
615-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
569-- >>> let search = mkSearch (Just query) Nothing
616-- >>> let search = mkSearch (Just query) Nothing
570-- >>> search
617-- >>> search
571−-- 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 = From 0, size = Size 10, fields = Nothing, source = Nothing}
618+-- 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 = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
572-- >>> pageSearch (From 10) (Size 100) search
619-- >>> pageSearch (From 10) (Size 100) search
573−-- 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 = From 10, size = Size 100, fields = Nothing, source = Nothing}
620+-- 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 = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
574pageSearch :: From -- ^ The result offset
621pageSearch :: From -- ^ The result offset
575 -> Size -- ^ The number of results to return
622 -> Size -- ^ The number of results to return
576 -> Search -- ^ The current seach
623 -> Search -- ^ The current seach