f535e7e · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Add support for 'Phrase Suggester' (V5)

f535e7eJosh Berman9 years ago

src/Database/V5/Bloodhound/Client.hs+3−3

compare with master

unifiedsplit

@@ -1044,7 +1044,7 @@ scanSearch indexName mappingName search = do

1044-- >>> mkSearch (Just query) Nothing

1045-- 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}

1046mkSearch :: Maybe Query -> Maybe Filter -> Search

1047−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing

1047+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing

1048

1049-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for

1050-- the 'Query' and the 'Aggregation'.

@@ -1054,7 +1054,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From

1054-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})

1055-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms

1056mkAggregateSearch :: Maybe Query -> Aggregations -> Search

1057−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing

1057+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing

1058

1059-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for

1060-- the 'Query' and the 'Aggregation'.

@@ -1063,7 +1063,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear

1063-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]

1064-- >>> let search = mkHighlightSearch (Just query) testHighlight

1065mkHighlightSearch :: Maybe Query -> Highlights -> Search

1066−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing

1066+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing

1067

1068-- | 'pageSearch' is a helper function that takes a search and assigns the from

1069-- and size fields for the search. The from parameter defines the offset

src/Database/V5/Bloodhound/Types.hs+75−10

@@ -330,6 +330,10 @@ module Database.V5.Bloodhound.Types

330 , PhraseSuggester(..)

331 , PhraseSuggesterHighlighter(..)

332 , PhraseSuggesterCollate(..)

333+ , mkPhraseSuggester

334+ , SuggestOptions(..)

335+ , SuggestResponse(..)

336+ , NamedSuggestionResponse(..)

333

337

334 , Aggregation(..)

338 , Aggregation(..)

335 , Aggregations

339 , Aggregations

@@ -1116,7 +1120,9 @@ data Search = Search { queryBody :: Maybe Query

1116 , size :: Size

1120 , size :: Size

1117 , searchType :: SearchType

1121 , searchType :: SearchType

1118 , fields :: Maybe [FieldName]

1122 , fields :: Maybe [FieldName]

1123+ , source :: Maybe Source

1124+ , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.

1119− , source :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)

1125+ } deriving (Eq, Read, Show, Generic, Typeable)

1120

1126

1121data SearchType = SearchTypeQueryThenFetch

1127data SearchType = SearchTypeQueryThenFetch

1122 | SearchTypeDfsQueryThenFetch

1128 | SearchTypeDfsQueryThenFetch

@@ -1663,13 +1669,17 @@ instance FromJSON TemplateQueryInline where

1663 <$> o .: "inline"

1669 <$> o .: "inline"

1664 <*> o .: "params"

1670 <*> o .: "params"

1665

1671

1672+

1666data SearchResult a =

1673data SearchResult a =

1667 SearchResult { took :: Int

1674 SearchResult { took :: Int

1668 , timedOut :: Bool

1675 , timedOut :: Bool

1669 , shards :: ShardResult

1676 , shards :: ShardResult

1670 , searchHits :: SearchHits a

1677 , searchHits :: SearchHits a

1671 , aggregations :: Maybe AggregationResults

1678 , aggregations :: Maybe AggregationResults

1679+ , scrollId :: Maybe ScrollId

1680+ , suggest :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.

1681+ }

1672− , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)

1682+ deriving (Eq, Read, Show, Generic, Typeable)

1673

1683

1674newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)

1684newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)

1675

1685

@@ -3258,7 +3268,7 @@ instance FromJSON SearchAliasRouting where

3258 where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)

3268 where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)

3259

3269

3260instance ToJSON Search where

3270instance ToJSON Search where

3261− toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =

3271+ toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =

3262 omitNulls [ "query" .= query'

3272 omitNulls [ "query" .= query'

3263 , "sort" .= sort

3273 , "sort" .= sort

3264 , "aggregations" .= searchAggs

3274 , "aggregations" .= searchAggs

@@ -3267,7 +3277,8 @@ instance ToJSON Search where

3267 , "size" .= sSize

3277 , "size" .= sSize

3268 , "track_scores" .= sTrackSortScores

3278 , "track_scores" .= sTrackSortScores

3269 , "fields" .= sFields

3279 , "fields" .= sFields

3270− , "_source" .= sSource]

3280+ , "_source" .= sSource

3281+ , "suggest" .= sSuggest]

3271

3282

3272 where query' = case sFilter of

3283 where query' = case sFilter of

3273 Nothing -> mquery

3284 Nothing -> mquery

@@ -3620,7 +3631,8 @@ instance (FromJSON a) => FromJSON (SearchResult a) where

3620 v .: "_shards" <*>

3631 v .: "_shards" <*>

3621 v .: "hits" <*>

3632 v .: "hits" <*>

3622 v .:? "aggregations" <*>

3633 v .:? "aggregations" <*>

3623− v .:? "_scroll_id"

3634+ v .:? "_scroll_id" <*>

3635+ v .:? "suggest"

3624 parseJSON _ = empty

3636 parseJSON _ = empty

3625

3637

3626instance (FromJSON a) => FromJSON (SearchHits a) where

3638instance (FromJSON a) => FromJSON (SearchHits a) where

@@ -5106,7 +5118,7 @@ data Suggest = Suggest { suggestText :: Text

5106 , suggestName :: Text

5118 , suggestName :: Text

5107 , suggestType :: SuggestType

5119 , suggestType :: SuggestType

5108 }

5120 }

5109− deriving (Show, Generic)

5121+ deriving (Show, Generic, Eq, Read)

5110

5122

5111instance ToJSON Suggest where

5123instance ToJSON Suggest where

5112 toJSON Suggest{..} = object [ "text" .= suggestText

5124 toJSON Suggest{..} = object [ "text" .= suggestText

@@ -5125,7 +5137,7 @@ instance FromJSON Suggest where

5125 parseJSON x = typeMismatch "Suggest" x

5137 parseJSON x = typeMismatch "Suggest" x

5126

5138

5127data SuggestType = SuggestTypePhraseSuggester PhraseSuggester

5139data SuggestType = SuggestTypePhraseSuggester PhraseSuggester

5128− deriving (Show, Generic)

5140+ deriving (Show, Generic, Eq, Read)

5129

5141

5130instance ToJSON SuggestType where

5142instance ToJSON SuggestType where

5131 toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]

5143 toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]

@@ -5149,7 +5161,7 @@ data PhraseSuggester =

5149 , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter

5161 , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter

5150 , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate

5162 , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate

5151 }

5163 }

5152− deriving (Show, Generic)

5164+ deriving (Show, Generic, Eq, Read)

5153

5165

5154instance ToJSON PhraseSuggester where

5166instance ToJSON PhraseSuggester where

5155 toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField

5167 toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField

@@ -5180,11 +5192,16 @@ instance FromJSON PhraseSuggester where

5180 <*> o .:? "highlight"

5192 <*> o .:? "highlight"

5181 <*> o .:? "collate"

5193 <*> o .:? "collate"

5182

5194

5195+mkPhraseSuggester :: FieldName -> PhraseSuggester

5196+mkPhraseSuggester fName =

5197+ PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing

5198+ Nothing Nothing Nothing Nothing

5199+

5183data PhraseSuggesterHighlighter =

5200data PhraseSuggesterHighlighter =

5184 PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text

5201 PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text

5185 , phraseSuggesterHighlighterPostTag :: Text

5202 , phraseSuggesterHighlighterPostTag :: Text

5186 }

5203 }

5187− deriving (Show, Generic)

5204+ deriving (Show, Generic, Eq, Read)

5188

5205

5189instance ToJSON PhraseSuggesterHighlighter where

5206instance ToJSON PhraseSuggesterHighlighter where

5190 toJSON PhraseSuggesterHighlighter{..} =

5207 toJSON PhraseSuggesterHighlighter{..} =

@@ -5202,7 +5219,7 @@ data PhraseSuggesterCollate =

5202 PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline

5219 PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline

5203 , phraseSuggesterCollatePrune :: Bool

5220 , phraseSuggesterCollatePrune :: Bool

5204 }

5221 }

5205− deriving (Show, Generic)

5222+ deriving (Show, Generic, Eq, Read)

5206

5223

5207instance ToJSON PhraseSuggesterCollate where

5224instance ToJSON PhraseSuggesterCollate where

5208 toJSON PhraseSuggesterCollate{..} = object [ "query" .= object

5225 toJSON PhraseSuggesterCollate{..} = object [ "query" .= object

@@ -5220,3 +5237,51 @@ instance FromJSON PhraseSuggesterCollate where

5220 prune' <- o .:? "prune" .!= False

5237 prune' <- o .:? "prune" .!= False

5221 return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'

5238 return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'

5222 parseJSON x = typeMismatch "PhraseSuggesterCollate" x

5239 parseJSON x = typeMismatch "PhraseSuggesterCollate" x

5240+

5241+data SuggestOptions =

5242+ SuggestOptions { suggestOptionsText :: Text

5243+ , suggestOptionsScore :: Double

5244+ , suggestOptionsFreq :: Maybe Int

5245+ , suggestOptionsHighlighted :: Maybe Text

5246+ }

5247+ deriving (Eq, Read, Show)

5248+

5249+instance FromJSON SuggestOptions where

5250+ parseJSON = withObject "SuggestOptions" parse

5251+ where parse o = SuggestOptions

5252+ <$> o .: "text"

5253+ <*> o .: "score"

5254+ <*> o .:? "freq"

5255+ <*> o .:? "highlighted"

5256+

5257+data SuggestResponse =

5258+ SuggestResponse { suggestResponseText :: Text

5259+ , suggestResponseOffset :: Int

5260+ , suggestResponseLength :: Int

5261+ , suggestResponseOptions :: [SuggestOptions]

5262+ }

5263+ deriving (Eq, Read, Show)

5264+

5265+instance FromJSON SuggestResponse where

5266+ parseJSON = withObject "SuggestResponse" parse

5267+ where parse o = SuggestResponse

5268+ <$> o .: "text"

5269+ <*> o .: "offset"

5270+ <*> o .: "length"

5271+ <*> o .: "options"

5272+

5273+data NamedSuggestionResponse =

5274+ NamedSuggestionResponse { nsrName :: Text

5275+ , nsrResponses :: [SuggestResponse]

5276+ }

5277+ deriving (Eq, Read, Show)

5278+

5279+instance FromJSON NamedSuggestionResponse where

5280+ parseJSON (Object o) = do

5281+ suggestionName' <- case HM.toList o of

5282+ [(x, _)] -> return x

5283+ _ -> fail "error parsing NamedSuggestionResponse name"

5284+ suggestionResponses' <- o .: suggestionName'

5285+ return $ NamedSuggestionResponse suggestionName' suggestionResponses'

5286+

5287+ parseJSON x = typeMismatch "NamedSuggestionResponse" x

tests/V5/tests.hs+16

@@ -1144,6 +1144,7 @@ main = hspec $ do

1144 let search = Search Nothing

1145 Nothing (Just [sortSpec]) Nothing Nothing

1146 False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing

1147+ Nothing

1147 result <- searchTweets search

1148 result <- searchTweets search

1148 let myTweet = grabFirst result

1149 let myTweet = grabFirst result

1149 liftIO $

1150 liftIO $

@@ -1582,6 +1583,21 @@ main = hspec $ do

1582 resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings

1583 resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings

1583 liftIO $ validateStatus resp 200

1584 liftIO $ validateStatus resp 200

1584

1585

1586+ describe "Suggest" $ do

1587+ it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do

1588+ _ <- insertData

1589+ let query = QueryMatchNoneQuery

1590+ phraseSuggester = mkPhraseSuggester (FieldName "message")

1591+ namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)

1592+ search' = mkSearch (Just query) Nothing

1593+ search = search' { suggestBody = Just namedSuggester }

1594+ expectedText = Just "use haskell"

1595+ resp <- searchByIndex testIndex search

1596+ parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))

1597+ case parsed of

1598+ Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)

1599+ Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText

1600+

1585 describe "JSON instances" $ do

1601 describe "JSON instances" $ do

1586 propJSON (Proxy :: Proxy Version)

1602 propJSON (Proxy :: Proxy Version)

1587 propJSON (Proxy :: Proxy IndexName)

1603 propJSON (Proxy :: Proxy IndexName)