@@ -59,6 +59,7 @@ import Data.ByteString.Lazy.Builder
5959import qualified Data.ByteString.Lazy.Char8 as L
6060import Data.Default.Class
6161import Data.Maybe (fromMaybe)
62+import Data.Monoid ((<>))
6263import Data.Text (Text)
6364import qualified Data.Text as T
6465import qualified Data.Text.Encoding as T
@@ -160,10 +161,28 @@ joinPath ps = do
160161 Server s <- bhServer <$> getBHEnv
161162 return $ joinPath' (s:ps)
162163
164+appendQueryParam :: Text -> Text -> Text
165+appendQueryParam originalUrl newParams = originalUrl <> joiner <> newParams
166+ where joiner
167+ | T.any (== '?') originalUrl = "&"
168+ | otherwise = "?"
169+
170+appendSearchTypeParam :: Text -> SearchType -> Text
171+appendSearchTypeParam originalUrl st = appendQueryParam originalUrl (keyEq <> stParams)
172+ where keyEq = "search_type="
173+ stParams
174+ | st == SearchTypeDfsQueryThenFetch = "dfs_query_then_fetch"
175+ | st == SearchTypeCount = "count"
176+ | st == SearchTypeScan = "scan&scroll=1m"
177+ | st == SearchTypeQueryAndFetch = "query_and_fetch"
178+ | st == SearchTypeDfsQueryAndFetch = "dfs_query_and_fetch"
179+ -- used to catch 'SearchTypeQueryThenFetch', which is also the default
180+ | otherwise = "query_then_fetch"
181+
163182bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
164183bindM2 f ma mb = join (f <$> ma <*> mb)
165184
166−-- | Convenience function that sets up a mananager and BHEnv and runs
185+-- | Convenience function that sets up a manager and BHEnv and runs
167186-- the given set of bloodhound operations. Connections will be
168187-- pipelined automatically in accordance with the given manager
169188-- settings in IO. If you've got your own monad transformer stack, you
@@ -428,7 +447,8 @@ documentExists (IndexName indexName)
428447 where url = joinPath [indexName, mappingName, docId]
429448
430449dispatchSearch :: MonadBH m => Text -> Search -> m Reply
431−dispatchSearch url search = post url (Just (encode search))
450+dispatchSearch url search = post url' (Just (encode search))
451+ where url' = appendSearchTypeParam url (searchType search)
432452
433453-- | 'searchAll', given a 'Search', will perform that search against all indexes
434454-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
@@ -471,7 +491,7 @@ searchByType (IndexName indexName)
471491-- >>> mkSearch (Just query) Nothing
472492-- 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}
473493mkSearch :: Maybe Query -> Maybe Filter -> Search
474−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10)
494+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch
475495
476496-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
477497-- the 'Query' and the 'Aggregation'.
@@ -481,7 +501,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
481501-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
482502-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
483503mkAggregateSearch :: Maybe Query -> Aggregations -> Search
484−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0)
504+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch
485505
486506-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
487507-- the 'Query' and the 'Aggregation'.
@@ -490,7 +510,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
490510-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
491511-- >>> let search = mkHighlightSearch (Just query) testHighlight
492512mkHighlightSearch :: Maybe Query -> Highlights -> Search
493−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10)
513+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch
494514
495515-- | 'pageSearch' is a helper function that takes a search and assigns the from
496516-- and size fields for the search. The from parameter defines the offset