git.iko.soy/typeable/bloodhound
on master help sign in
Colocate instances w/ datatypes
8cc7396Chris Allen
src/Database/V5/Bloodhound/Internal/Query.hs+1068−1053
compare with master
unifiedsplit
@@ -49,6 +49,173 @@ data Query =
49 | QueryMatchNoneQuery
49 | QueryMatchNoneQuery
50 deriving (Eq, Show)
50 deriving (Eq, Show)
51
51
52+instance ToJSON Query where
53+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
54+ object [ "term" .=
55+ object [termQueryField .= object merged]]
56+ where
57+ base = [ "value" .= termQueryValue ]
58+ boosted = maybe [] (return . ("boost" .=)) boost
59+ merged = mappend base boosted
60+
61+ toJSON (TermsQuery fieldName terms) =
62+ object [ "terms" .= object conjoined ]
63+ where conjoined = [fieldName .= terms]
64+
65+ toJSON (IdsQuery idsQueryMappingName docIds) =
66+ object [ "ids" .= object conjoined ]
67+ where conjoined = [ "type" .= idsQueryMappingName
68+ , "values" .= fmap toJSON docIds ]
69+
70+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
71+ object [ "query_string" .= qQueryStringQuery ]
72+
73+ toJSON (QueryMatchQuery matchQuery) =
74+ object [ "match" .= matchQuery ]
75+
76+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
77+ toJSON multiMatchQuery
78+
79+ toJSON (QueryBoolQuery boolQuery) =
80+ object [ "bool" .= boolQuery ]
81+
82+ toJSON (QueryBoostingQuery boostingQuery) =
83+ object [ "boosting" .= boostingQuery ]
84+
85+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
86+ object [ "common" .= commonTermsQuery ]
87+
88+ toJSON (ConstantScoreQuery query boost) =
89+ object ["constant_score" .= object ["query" .= query
90+ , "boost" .= boost]]
91+
92+ toJSON (QueryFunctionScoreQuery functionScoreQuery) =
93+ object [ "function_score" .= functionScoreQuery ]
94+
95+ toJSON (QueryDisMaxQuery disMaxQuery) =
96+ object [ "dis_max" .= disMaxQuery ]
97+
98+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
99+ object [ "fuzzy_like_this" .= fuzzyQuery ]
100+
101+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
102+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
103+
104+ toJSON (QueryFuzzyQuery fuzzyQuery) =
105+ object [ "fuzzy" .= fuzzyQuery ]
106+
107+ toJSON (QueryHasChildQuery childQuery) =
108+ object [ "has_child" .= childQuery ]
109+
110+ toJSON (QueryHasParentQuery parentQuery) =
111+ object [ "has_parent" .= parentQuery ]
112+
113+ toJSON (QueryIndicesQuery qIndicesQuery) =
114+ object [ "indices" .= qIndicesQuery ]
115+
116+ toJSON (MatchAllQuery boost) =
117+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
118+
119+ toJSON (QueryMoreLikeThisQuery query) =
120+ object [ "more_like_this" .= query ]
121+
122+ toJSON (QueryMoreLikeThisFieldQuery query) =
123+ object [ "more_like_this_field" .= query ]
124+
125+ toJSON (QueryNestedQuery query) =
126+ object [ "nested" .= query ]
127+
128+ toJSON (QueryPrefixQuery query) =
129+ object [ "prefix" .= query ]
130+
131+ toJSON (QueryRangeQuery query) =
132+ object [ "range" .= query ]
133+
134+ toJSON (QueryRegexpQuery query) =
135+ object [ "regexp" .= query ]
136+
137+ toJSON (QuerySimpleQueryStringQuery query) =
138+ object [ "simple_query_string" .= query ]
139+
140+ toJSON (QueryExistsQuery (FieldName fieldName)) =
141+ object ["exists" .= object
142+ ["field" .= fieldName]
143+ ]
144+ toJSON QueryMatchNoneQuery =
145+ object ["match_none" .= object []]
146+
147+ toJSON (QueryTemplateQueryInline templateQuery) =
148+ object [ "template" .= templateQuery ]
149+
150+instance FromJSON Query where
151+ parseJSON v = withObject "Query" parse v
152+ where parse o = termQuery `taggedWith` "term"
153+ <|> termsQuery `taggedWith` "terms"
154+ <|> idsQuery `taggedWith` "ids"
155+ <|> queryQueryStringQuery `taggedWith` "query_string"
156+ <|> queryMatchQuery `taggedWith` "match"
157+ <|> queryMultiMatchQuery
158+ <|> queryBoolQuery `taggedWith` "bool"
159+ <|> queryBoostingQuery `taggedWith` "boosting"
160+ <|> queryCommonTermsQuery `taggedWith` "common"
161+ <|> constantScoreQuery `taggedWith` "constant_score"
162+ <|> queryFunctionScoreQuery `taggedWith` "function_score"
163+ <|> queryDisMaxQuery `taggedWith` "dis_max"
164+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
165+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
166+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
167+ <|> queryHasChildQuery `taggedWith` "has_child"
168+ <|> queryHasParentQuery `taggedWith` "has_parent"
169+ <|> queryIndicesQuery `taggedWith` "indices"
170+ <|> matchAllQuery `taggedWith` "match_all"
171+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
172+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
173+ <|> queryNestedQuery `taggedWith` "nested"
174+ <|> queryPrefixQuery `taggedWith` "prefix"
175+ <|> queryRangeQuery `taggedWith` "range"
176+ <|> queryRegexpQuery `taggedWith` "regexp"
177+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
178+ <|> queryTemplateQueryInline `taggedWith` "template"
179+ where taggedWith parser k = parser =<< o .: k
180+ termQuery = fieldTagged $ \(FieldName fn) o ->
181+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
182+ termsQuery o = case HM.toList o of
183+ [(fn, vs)] -> do vals <- parseJSON vs
184+ case vals of
185+ x:xs -> return (TermsQuery fn (x :| xs))
186+ _ -> fail "Expected non empty list of values"
187+ _ -> fail "Expected object with 1 field-named key"
188+ idsQuery o = IdsQuery <$> o .: "type"
189+ <*> o .: "values"
190+ queryQueryStringQuery = pure . QueryQueryStringQuery
191+ queryMatchQuery = pure . QueryMatchQuery
192+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
193+ queryBoolQuery = pure . QueryBoolQuery
194+ queryBoostingQuery = pure . QueryBoostingQuery
195+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
196+ constantScoreQuery o = case HM.lookup "query" o of
197+ Just x -> ConstantScoreQuery <$> parseJSON x
198+ <*> o .: "boost"
199+ _ -> fail "Does not appear to be a ConstantScoreQuery"
200+ queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
201+ queryDisMaxQuery = pure . QueryDisMaxQuery
202+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
203+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
204+ queryFuzzyQuery = pure . QueryFuzzyQuery
205+ queryHasChildQuery = pure . QueryHasChildQuery
206+ queryHasParentQuery = pure . QueryHasParentQuery
207+ queryIndicesQuery = pure . QueryIndicesQuery
208+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
209+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
210+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
211+ queryNestedQuery = pure . QueryNestedQuery
212+ queryPrefixQuery = pure . QueryPrefixQuery
213+ queryRangeQuery = pure . QueryRangeQuery
214+ queryRegexpQuery = pure . QueryRegexpQuery
215+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
216+ -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
217+ queryTemplateQueryInline = pure . QueryTemplateQueryInline
218+
52-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
219-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
53-- Bool Query, and flagged in a different context.
220-- Bool Query, and flagged in a different context.
54newtype Filter = Filter { unFilter :: Query }
221newtype Filter = Filter { unFilter :: Query }
@@ -67,11 +234,41 @@ data RegexpQuery =
67 , regexpQueryBoost :: Maybe Boost
234 , regexpQueryBoost :: Maybe Boost
68 } deriving (Eq, Show)
235 } deriving (Eq, Show)
69
236
237+instance ToJSON RegexpQuery where
238+ toJSON (RegexpQuery (FieldName rqQueryField)
239+ (Regexp regexpQueryQuery) rqQueryFlags
240+ rqQueryBoost) =
241+ object [ rqQueryField .= omitNulls base ]
242+ where base = [ "value" .= regexpQueryQuery
243+ , "flags" .= rqQueryFlags
244+ , "boost" .= rqQueryBoost ]
245+
246+instance FromJSON RegexpQuery where
247+ parseJSON = withObject "RegexpQuery" parse
248+ where parse = fieldTagged $ \fn o ->
249+ RegexpQuery fn
250+ <$> o .: "value"
251+ <*> o .: "flags"
252+ <*> o .:? "boost"
253+
70data RangeQuery =
254data RangeQuery =
71 RangeQuery { rangeQueryField :: FieldName
255 RangeQuery { rangeQueryField :: FieldName
72 , rangeQueryRange :: RangeValue
256 , rangeQueryRange :: RangeValue
73 , rangeQueryBoost :: Boost } deriving (Eq, Show)
257 , rangeQueryBoost :: Boost } deriving (Eq, Show)
74
258
259+instance ToJSON RangeQuery where
260+ toJSON (RangeQuery (FieldName fieldName) range boost) =
261+ object [ fieldName .= object conjoined ]
262+ where
263+ conjoined = ("boost" .= boost) : rangeValueToPair range
264+
265+instance FromJSON RangeQuery where
266+ parseJSON = withObject "RangeQuery" parse
267+ where parse = fieldTagged $ \fn o ->
268+ RangeQuery fn
269+ <$> parseJSON (Object o)
270+ <*> o .: "boost"
271+
75mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
272mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
76mkRangeQuery f r = RangeQuery f r (Boost 1.0)
273mkRangeQuery f r = RangeQuery f r (Boost 1.0)
77
274
@@ -86,8 +283,32 @@ data SimpleQueryStringQuery =
86 , simpleQueryStringLocale :: Maybe Locale
283 , simpleQueryStringLocale :: Maybe Locale
87 } deriving (Eq, Show)
284 } deriving (Eq, Show)
88
285
286+
287+instance ToJSON SimpleQueryStringQuery where
288+ toJSON SimpleQueryStringQuery {..} =
289+ omitNulls (base ++ maybeAdd)
290+ where base = [ "query" .= simpleQueryStringQuery ]
291+ maybeAdd = [ "fields" .= simpleQueryStringField
292+ , "default_operator" .= simpleQueryStringOperator
293+ , "analyzer" .= simpleQueryStringAnalyzer
294+ , "flags" .= simpleQueryStringFlags
295+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
296+ , "locale" .= simpleQueryStringLocale ]
297+
298+instance FromJSON SimpleQueryStringQuery where
299+ parseJSON = withObject "SimpleQueryStringQuery" parse
300+ where parse o = SimpleQueryStringQuery <$> o .: "query"
301+ <*> o .:? "fields"
302+ <*> o .:? "default_operator"
303+ <*> o .:? "analyzer"
304+ <*> (parseFlags <$> o .:? "flags")
305+ <*> o .:? "lowercase_expanded_terms"
306+ <*> o .:? "locale"
307+ parseFlags (Just (x:xs)) = Just (x :| xs)
308+ parseFlags _ = Nothing
309+
89data SimpleQueryFlag =
310data SimpleQueryFlag =
90− SimpleQueryAll
311+ SimpleQueryAll
91 | SimpleQueryNone
312 | SimpleQueryNone
92 | SimpleQueryAnd
313 | SimpleQueryAnd
93 | SimpleQueryOr
314 | SimpleQueryOr
@@ -100,6 +321,36 @@ data SimpleQueryFlag =
100 | SimpleQueryNear
321 | SimpleQueryNear
101 | SimpleQuerySlop deriving (Eq, Show)
322 | SimpleQuerySlop deriving (Eq, Show)
102
323
324+instance ToJSON SimpleQueryFlag where
325+ toJSON SimpleQueryAll = "ALL"
326+ toJSON SimpleQueryNone = "NONE"
327+ toJSON SimpleQueryAnd = "AND"
328+ toJSON SimpleQueryOr = "OR"
329+ toJSON SimpleQueryPrefix = "PREFIX"
330+ toJSON SimpleQueryPhrase = "PHRASE"
331+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
332+ toJSON SimpleQueryEscape = "ESCAPE"
333+ toJSON SimpleQueryWhitespace = "WHITESPACE"
334+ toJSON SimpleQueryFuzzy = "FUZZY"
335+ toJSON SimpleQueryNear = "NEAR"
336+ toJSON SimpleQuerySlop = "SLOP"
337+
338+instance FromJSON SimpleQueryFlag where
339+ parseJSON = withText "SimpleQueryFlag" parse
340+ where parse "ALL" = pure SimpleQueryAll
341+ parse "NONE" = pure SimpleQueryNone
342+ parse "AND" = pure SimpleQueryAnd
343+ parse "OR" = pure SimpleQueryOr
344+ parse "PREFIX" = pure SimpleQueryPrefix
345+ parse "PHRASE" = pure SimpleQueryPhrase
346+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
347+ parse "ESCAPE" = pure SimpleQueryEscape
348+ parse "WHITESPACE" = pure SimpleQueryWhitespace
349+ parse "FUZZY" = pure SimpleQueryFuzzy
350+ parse "NEAR" = pure SimpleQueryNear
351+ parse "SLOP" = pure SimpleQuerySlop
352+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
353+
103-- use_dis_max and tie_breaker when fields are plural?
354-- use_dis_max and tie_breaker when fields are plural?
104data QueryStringQuery =
355data QueryStringQuery =
105 QueryStringQuery
356 QueryStringQuery
@@ -122,29 +373,117 @@ data QueryStringQuery =
122 , queryStringLocale :: Maybe Locale
373 , queryStringLocale :: Maybe Locale
123 } deriving (Eq, Show)
374 } deriving (Eq, Show)
124
375
376+
377+instance ToJSON QueryStringQuery where
378+ toJSON (QueryStringQuery qsQueryString
379+ qsDefaultField qsOperator
380+ qsAnalyzer qsAllowWildcard
381+ qsLowercaseExpanded qsEnablePositionIncrements
382+ qsFuzzyMaxExpansions qsFuzziness
383+ qsFuzzyPrefixLength qsPhraseSlop
384+ qsBoost qsAnalyzeWildcard
385+ qsGeneratePhraseQueries qsMinimumShouldMatch
386+ qsLenient qsLocale) =
387+ omitNulls base
388+ where
389+ base = [ "query" .= qsQueryString
390+ , "default_field" .= qsDefaultField
391+ , "default_operator" .= qsOperator
392+ , "analyzer" .= qsAnalyzer
393+ , "allow_leading_wildcard" .= qsAllowWildcard
394+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
395+ , "enable_position_increments" .= qsEnablePositionIncrements
396+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
397+ , "fuzziness" .= qsFuzziness
398+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
399+ , "phrase_slop" .= qsPhraseSlop
400+ , "boost" .= qsBoost
401+ , "analyze_wildcard" .= qsAnalyzeWildcard
402+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
403+ , "minimum_should_match" .= qsMinimumShouldMatch
404+ , "lenient" .= qsLenient
405+ , "locale" .= qsLocale ]
406+
407+instance FromJSON QueryStringQuery where
408+ parseJSON = withObject "QueryStringQuery" parse
409+ where parse o = QueryStringQuery
410+ <$> o .: "query"
411+ <*> o .:? "default_field"
412+ <*> o .:? "default_operator"
413+ <*> o .:? "analyzer"
414+ <*> o .:? "allow_leading_wildcard"
415+ <*> o .:? "lowercase_expanded_terms"
416+ <*> o .:? "enable_position_increments"
417+ <*> o .:? "fuzzy_max_expansions"
418+ <*> o .:? "fuzziness"
419+ <*> o .:? "fuzzy_prefix_length"
420+ <*> o .:? "phrase_slop"
421+ <*> o .:? "boost"
422+ <*> o .:? "analyze_wildcard"
423+ <*> o .:? "auto_generate_phrase_queries"
424+ <*> o .:? "minimum_should_match"
425+ <*> o .:? "lenient"
426+ <*> o .:? "locale"
427+
125−mkQueryStringQuery :: QueryString -> QueryStringQuery
428+mkQueryStringQuery :: QueryString -> QueryStringQuery
126−mkQueryStringQuery qs =
429+mkQueryStringQuery qs =
127− QueryStringQuery qs Nothing Nothing
430+ QueryStringQuery qs Nothing Nothing
128− Nothing Nothing Nothing Nothing
431+ Nothing Nothing Nothing Nothing
129− Nothing Nothing Nothing Nothing
432+ Nothing Nothing Nothing Nothing
130 Nothing Nothing Nothing Nothing
433 Nothing Nothing Nothing Nothing
131 Nothing Nothing
434 Nothing Nothing
132
435
133data FieldOrFields = FofField FieldName
436data FieldOrFields = FofField FieldName
134 | FofFields (NonEmpty FieldName) deriving (Eq, Show)
437 | FofFields (NonEmpty FieldName) deriving (Eq, Show)
135
438
439+instance ToJSON FieldOrFields where
440+ toJSON (FofField fieldName) =
441+ toJSON fieldName
442+ toJSON (FofFields fieldNames) =
443+ toJSON fieldNames
444+
445+instance FromJSON FieldOrFields where
446+ parseJSON v = FofField <$> parseJSON v
447+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
448+
136data PrefixQuery =
449data PrefixQuery =
137 PrefixQuery
450 PrefixQuery
138 { prefixQueryField :: FieldName
451 { prefixQueryField :: FieldName
139 , prefixQueryPrefixValue :: Text
452 , prefixQueryPrefixValue :: Text
140 , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)
453 , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)
141
454
455+instance ToJSON PrefixQuery where
456+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
457+ object [ fieldName .= omitNulls base ]
458+ where base = [ "value" .= queryValue
459+ , "boost" .= boost ]
460+
461+instance FromJSON PrefixQuery where
462+ parseJSON = withObject "PrefixQuery" parse
463+ where parse = fieldTagged $ \fn o ->
464+ PrefixQuery fn
465+ <$> o .: "value"
466+ <*> o .:? "boost"
467+
142data NestedQuery =
468data NestedQuery =
143 NestedQuery
469 NestedQuery
144 { nestedQueryPath :: QueryPath
470 { nestedQueryPath :: QueryPath
145 , nestedQueryScoreType :: ScoreType
471 , nestedQueryScoreType :: ScoreType
146 , nestedQuery :: Query } deriving (Eq, Show)
472 , nestedQuery :: Query } deriving (Eq, Show)
147
473
474+instance ToJSON NestedQuery where
475+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
476+ object [ "path" .= nqPath
477+ , "score_mode" .= nqScoreType
478+ , "query" .= nqQuery ]
479+
480+instance FromJSON NestedQuery where
481+ parseJSON = withObject "NestedQuery" parse
482+ where parse o = NestedQuery
483+ <$> o .: "path"
484+ <*> o .: "score_mode"
485+ <*> o .: "query"
486+
148data MoreLikeThisFieldQuery =
487data MoreLikeThisFieldQuery =
149 MoreLikeThisFieldQuery
488 MoreLikeThisFieldQuery
150 { moreLikeThisFieldText :: Text
489 { moreLikeThisFieldText :: Text
@@ -163,6 +502,45 @@ data MoreLikeThisFieldQuery =
163 , moreLikeThisFieldAnalyzer :: Maybe Analyzer
502 , moreLikeThisFieldAnalyzer :: Maybe Analyzer
164 } deriving (Eq, Show)
503 } deriving (Eq, Show)
165
504
505+
506+instance ToJSON MoreLikeThisFieldQuery where
507+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
508+ percent mtf mqt stopwords mindf maxdf
509+ minwl maxwl boostTerms boost analyzer) =
510+ object [ fieldName .= omitNulls base ]
511+ where base = [ "like_text" .= text
512+ , "percent_terms_to_match" .= percent
513+ , "min_term_freq" .= mtf
514+ , "max_query_terms" .= mqt
515+ , "stop_words" .= stopwords
516+ , "min_doc_freq" .= mindf
517+ , "max_doc_freq" .= maxdf
518+ , "min_word_length" .= minwl
519+ , "max_word_length" .= maxwl
520+ , "boost_terms" .= boostTerms
521+ , "boost" .= boost
522+ , "analyzer" .= analyzer ]
523+
524+instance FromJSON MoreLikeThisFieldQuery where
525+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
526+ where parse = fieldTagged $ \fn o ->
527+ MoreLikeThisFieldQuery
528+ <$> o .: "like_text"
529+ <*> pure fn
530+ <*> o .:? "percent_terms_to_match"
531+ <*> o .:? "min_term_freq"
532+ <*> o .:? "max_query_terms"
533+ -- <*> (optionalNE =<< o .:? "stop_words")
534+ <*> o .:? "stop_words"
535+ <*> o .:? "min_doc_freq"
536+ <*> o .:? "max_doc_freq"
537+ <*> o .:? "min_word_length"
538+ <*> o .:? "max_word_length"
539+ <*> o .:? "boost_terms"
540+ <*> o .:? "boost"
541+ <*> o .:? "analyzer"
542+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
543+
166data MoreLikeThisQuery =
544data MoreLikeThisQuery =
167 MoreLikeThisQuery
545 MoreLikeThisQuery
168 { moreLikeThisText :: Text
546 { moreLikeThisText :: Text
@@ -181,6 +559,46 @@ data MoreLikeThisQuery =
181 , moreLikeThisAnalyzer :: Maybe Analyzer
559 , moreLikeThisAnalyzer :: Maybe Analyzer
182 } deriving (Eq, Show)
560 } deriving (Eq, Show)
183
561
562+
563+instance ToJSON MoreLikeThisQuery where
564+ toJSON (MoreLikeThisQuery text fields percent
565+ mtf mqt stopwords mindf maxdf
566+ minwl maxwl boostTerms boost analyzer) =
567+ omitNulls base
568+ where base = [ "like_text" .= text
569+ , "fields" .= fields
570+ , "percent_terms_to_match" .= percent
571+ , "min_term_freq" .= mtf
572+ , "max_query_terms" .= mqt
573+ , "stop_words" .= stopwords
574+ , "min_doc_freq" .= mindf
575+ , "max_doc_freq" .= maxdf
576+ , "min_word_length" .= minwl
577+ , "max_word_length" .= maxwl
578+ , "boost_terms" .= boostTerms
579+ , "boost" .= boost
580+ , "analyzer" .= analyzer ]
581+
582+instance FromJSON MoreLikeThisQuery where
583+ parseJSON = withObject "MoreLikeThisQuery" parse
584+ where parse o = MoreLikeThisQuery
585+ <$> o .: "like_text"
586+ -- <*> (optionalNE =<< o .:? "fields")
587+ <*> o .:? "fields"
588+ <*> o .:? "percent_terms_to_match"
589+ <*> o .:? "min_term_freq"
590+ <*> o .:? "max_query_terms"
591+ -- <*> (optionalNE =<< o .:? "stop_words")
592+ <*> o .:? "stop_words"
593+ <*> o .:? "min_doc_freq"
594+ <*> o .:? "max_doc_freq"
595+ <*> o .:? "min_word_length"
596+ <*> o .:? "max_word_length"
597+ <*> o .:? "boost_terms"
598+ <*> o .:? "boost"
599+ <*> o .:? "analyzer"
600+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
601+
184data IndicesQuery =
602data IndicesQuery =
185 IndicesQuery
603 IndicesQuery
186 { indicesQueryIndices :: [IndexName]
604 { indicesQueryIndices :: [IndexName]
@@ -188,24 +606,78 @@ data IndicesQuery =
188 -- default "all"
606 -- default "all"
189 , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)
607 , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)
190
608
609+
610+instance ToJSON IndicesQuery where
611+ toJSON (IndicesQuery indices query noMatch) =
612+ omitNulls [ "indices" .= indices
613+ , "no_match_query" .= noMatch
614+ , "query" .= query ]
615+
616+instance FromJSON IndicesQuery where
617+ parseJSON = withObject "IndicesQuery" parse
618+ where parse o = IndicesQuery
619+ <$> o .:? "indices" .!= []
620+ <*> o .: "query"
621+ <*> o .:? "no_match_query"
622+
191data HasParentQuery =
623data HasParentQuery =
192 HasParentQuery
624 HasParentQuery
193 { hasParentQueryType :: TypeName
625 { hasParentQueryType :: TypeName
194 , hasParentQuery :: Query
626 , hasParentQuery :: Query
195 , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
627 , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
196
628
629+instance ToJSON HasParentQuery where
630+ toJSON (HasParentQuery queryType query scoreType) =
631+ omitNulls [ "parent_type" .= queryType
632+ , "score_type" .= scoreType
633+ , "query" .= query ]
634+
635+instance FromJSON HasParentQuery where
636+ parseJSON = withObject "HasParentQuery" parse
637+ where parse o = HasParentQuery
638+ <$> o .: "parent_type"
639+ <*> o .: "query"
640+ <*> o .:? "score_type"
641+
197data HasChildQuery =
642data HasChildQuery =
198 HasChildQuery
643 HasChildQuery
199 { hasChildQueryType :: TypeName
644 { hasChildQueryType :: TypeName
200 , hasChildQuery :: Query
645 , hasChildQuery :: Query
201 , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
646 , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
202
647
648+instance ToJSON HasChildQuery where
649+ toJSON (HasChildQuery queryType query scoreType) =
650+ omitNulls [ "query" .= query
651+ , "score_type" .= scoreType
652+ , "type" .= queryType ]
653+
654+instance FromJSON HasChildQuery where
655+ parseJSON = withObject "HasChildQuery" parse
656+ where parse o = HasChildQuery
657+ <$> o .: "type"
658+ <*> o .: "query"
659+ <*> o .:? "score_type"
660+
203data ScoreType =
661data ScoreType =
204− ScoreTypeMax
662+ ScoreTypeMax
205 | ScoreTypeSum
663 | ScoreTypeSum
206 | ScoreTypeAvg
664 | ScoreTypeAvg
207 | ScoreTypeNone deriving (Eq, Show)
665 | ScoreTypeNone deriving (Eq, Show)
208
666
667+instance ToJSON ScoreType where
668+ toJSON ScoreTypeMax = "max"
669+ toJSON ScoreTypeAvg = "avg"
670+ toJSON ScoreTypeSum = "sum"
671+ toJSON ScoreTypeNone = "none"
672+
673+instance FromJSON ScoreType where
674+ parseJSON = withText "ScoreType" parse
675+ where parse "max" = pure ScoreTypeMax
676+ parse "avg" = pure ScoreTypeAvg
677+ parse "sum" = pure ScoreTypeSum
678+ parse "none" = pure ScoreTypeNone
679+ parse t = fail ("Unexpected ScoreType: " <> show t)
680+
209data FuzzyQuery =
681data FuzzyQuery =
210 FuzzyQuery { fuzzyQueryField :: FieldName
682 FuzzyQuery { fuzzyQueryField :: FieldName
211 , fuzzyQueryValue :: Text
683 , fuzzyQueryValue :: Text
@@ -215,6 +687,27 @@ data FuzzyQuery =
215 , fuzzyQueryBoost :: Maybe Boost
687 , fuzzyQueryBoost :: Maybe Boost
216 } deriving (Eq, Show)
688 } deriving (Eq, Show)
217
689
690+
691+instance ToJSON FuzzyQuery where
692+ toJSON (FuzzyQuery (FieldName fieldName) queryText
693+ prefixLength maxEx fuzziness boost) =
694+ object [ fieldName .= omitNulls base ]
695+ where base = [ "value" .= queryText
696+ , "fuzziness" .= fuzziness
697+ , "prefix_length" .= prefixLength
698+ , "boost" .= boost
699+ , "max_expansions" .= maxEx ]
700+
701+instance FromJSON FuzzyQuery where
702+ parseJSON = withObject "FuzzyQuery" parse
703+ where parse = fieldTagged $ \fn o ->
704+ FuzzyQuery fn
705+ <$> o .: "value"
706+ <*> o .: "prefix_length"
707+ <*> o .: "max_expansions"
708+ <*> o .: "fuzziness"
709+ <*> o .:? "boost"
710+
218data FuzzyLikeFieldQuery =
711data FuzzyLikeFieldQuery =
219 FuzzyLikeFieldQuery
712 FuzzyLikeFieldQuery
220 { fuzzyLikeField :: FieldName
713 { fuzzyLikeField :: FieldName
@@ -228,18 +721,70 @@ data FuzzyLikeFieldQuery =
228 , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
721 , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
229 } deriving (Eq, Show)
722 } deriving (Eq, Show)
230
723
724+
725+instance ToJSON FuzzyLikeFieldQuery where
726+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
727+ fieldText maxTerms ignoreFreq fuzziness prefixLength
728+ boost analyzer) =
729+ object [ fieldName .=
730+ omitNulls [ "like_text" .= fieldText
731+ , "max_query_terms" .= maxTerms
732+ , "ignore_tf" .= ignoreFreq
733+ , "fuzziness" .= fuzziness
734+ , "prefix_length" .= prefixLength
735+ , "analyzer" .= analyzer
736+ , "boost" .= boost ]]
737+
738+instance FromJSON FuzzyLikeFieldQuery where
739+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
740+ where parse = fieldTagged $ \fn o ->
741+ FuzzyLikeFieldQuery fn
742+ <$> o .: "like_text"
743+ <*> o .: "max_query_terms"
744+ <*> o .: "ignore_tf"
745+ <*> o .: "fuzziness"
746+ <*> o .: "prefix_length"
747+ <*> o .: "boost"
748+ <*> o .:? "analyzer"
749+
231−data FuzzyLikeThisQuery =
750+data FuzzyLikeThisQuery =
232− FuzzyLikeThisQuery
751+ FuzzyLikeThisQuery
233− { fuzzyLikeFields :: [FieldName]
752+ { fuzzyLikeFields :: [FieldName]
234− , fuzzyLikeText :: Text
753+ , fuzzyLikeText :: Text
235− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
754+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
236− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
755+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
237− , fuzzyLikeFuzziness :: Fuzziness
756+ , fuzzyLikeFuzziness :: Fuzziness
238− , fuzzyLikePrefixLength :: PrefixLength
757+ , fuzzyLikePrefixLength :: PrefixLength
239− , fuzzyLikeBoost :: Boost
758+ , fuzzyLikeBoost :: Boost
240 , fuzzyLikeAnalyzer :: Maybe Analyzer
759 , fuzzyLikeAnalyzer :: Maybe Analyzer
241 } deriving (Eq, Show)
760 } deriving (Eq, Show)
242
761
762+
763+instance ToJSON FuzzyLikeThisQuery where
764+ toJSON (FuzzyLikeThisQuery fields text maxTerms
765+ ignoreFreq fuzziness prefixLength boost analyzer) =
766+ omitNulls base
767+ where base = [ "fields" .= fields
768+ , "like_text" .= text
769+ , "max_query_terms" .= maxTerms
770+ , "ignore_tf" .= ignoreFreq
771+ , "fuzziness" .= fuzziness
772+ , "prefix_length" .= prefixLength
773+ , "analyzer" .= analyzer
774+ , "boost" .= boost ]
775+
776+instance FromJSON FuzzyLikeThisQuery where
777+ parseJSON = withObject "FuzzyLikeThisQuery" parse
778+ where parse o = FuzzyLikeThisQuery
779+ <$> o .:? "fields" .!= []
780+ <*> o .: "like_text"
781+ <*> o .: "max_query_terms"
782+ <*> o .: "ignore_tf"
783+ <*> o .: "fuzziness"
784+ <*> o .: "prefix_length"
785+ <*> o .: "boost"
786+ <*> o .:? "analyzer"
787+
243data DisMaxQuery =
788data DisMaxQuery =
244 DisMaxQuery { disMaxQueries :: [Query]
789 DisMaxQuery { disMaxQueries :: [Query]
245 -- default 0.0
790 -- default 0.0
@@ -247,19 +792,70 @@ data DisMaxQuery =
247 , disMaxBoost :: Maybe Boost
792 , disMaxBoost :: Maybe Boost
248 } deriving (Eq, Show)
793 } deriving (Eq, Show)
249
794
795+
796+instance ToJSON DisMaxQuery where
797+ toJSON (DisMaxQuery queries tiebreaker boost) =
798+ omitNulls base
799+ where base = [ "queries" .= queries
800+ , "boost" .= boost
801+ , "tie_breaker" .= tiebreaker ]
802+
803+instance FromJSON DisMaxQuery where
804+ parseJSON = withObject "DisMaxQuery" parse
805+ where parse o = DisMaxQuery
806+ <$> o .:? "queries" .!= []
807+ <*> o .: "tie_breaker"
808+ <*> o .:? "boost"
809+
250−data MatchQuery =
810+data MatchQuery = MatchQuery
251− MatchQuery { matchQueryField :: FieldName
811+ { matchQueryField :: FieldName
252− , matchQueryQueryString :: QueryString
812+ , matchQueryQueryString :: QueryString
253− , matchQueryOperator :: BooleanOperator
813+ , matchQueryOperator :: BooleanOperator
254− , matchQueryZeroTerms :: ZeroTermsQuery
814+ , matchQueryZeroTerms :: ZeroTermsQuery
255− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
815+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
256− , matchQueryMatchType :: Maybe MatchQueryType
816+ , matchQueryMatchType :: Maybe MatchQueryType
257− , matchQueryAnalyzer :: Maybe Analyzer
817+ , matchQueryAnalyzer :: Maybe Analyzer
258− , matchQueryMaxExpansions :: Maybe MaxExpansions
818+ , matchQueryMaxExpansions :: Maybe MaxExpansions
259− , matchQueryLenient :: Maybe Lenient
819+ , matchQueryLenient :: Maybe Lenient
260− , matchQueryBoost :: Maybe Boost
820+ , matchQueryBoost :: Maybe Boost
261− , matchQueryMinimumShouldMatch :: Maybe Text
821+ , matchQueryMinimumShouldMatch :: Maybe Text
262− } deriving (Eq, Show)
822+ } deriving (Eq, Show)
823+
824+
825+instance ToJSON MatchQuery where
826+ toJSON (MatchQuery (FieldName fieldName)
827+ (QueryString mqQueryString) booleanOperator
828+ zeroTermsQuery cutoffFrequency matchQueryType
829+ analyzer maxExpansions lenient boost
830+ minShouldMatch
831+ ) =
832+ object [ fieldName .= omitNulls base ]
833+ where base = [ "query" .= mqQueryString
834+ , "operator" .= booleanOperator
835+ , "zero_terms_query" .= zeroTermsQuery
836+ , "cutoff_frequency" .= cutoffFrequency
837+ , "type" .= matchQueryType
838+ , "analyzer" .= analyzer
839+ , "max_expansions" .= maxExpansions
840+ , "lenient" .= lenient
841+ , "boost" .= boost
842+ , "minimum_should_match" .= minShouldMatch
843+ ]
844+
845+instance FromJSON MatchQuery where
846+ parseJSON = withObject "MatchQuery" parse
847+ where parse = fieldTagged $ \fn o ->
848+ MatchQuery fn
849+ <$> o .: "query"
850+ <*> o .: "operator"
851+ <*> o .: "zero_terms_query"
852+ <*> o .:? "cutoff_frequency"
853+ <*> o .:? "type"
854+ <*> o .:? "analyzer"
855+ <*> o .:? "max_expansions"
856+ <*> o .:? "lenient"
857+ <*> o .:? "boost"
858+ <*> o .:? "minimum_should_match"
263
859
264{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
860{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
265 enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
861 enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
@@ -268,20 +864,61 @@ mkMatchQuery :: FieldName -> QueryString -> MatchQuery
268mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing
864mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing
269
865
270data MatchQueryType =
866data MatchQueryType =
271− MatchPhrase
867+ MatchPhrase
272 | MatchPhrasePrefix deriving (Eq, Show)
868 | MatchPhrasePrefix deriving (Eq, Show)
273
869
870+instance ToJSON MatchQueryType where
871+ toJSON MatchPhrase = "phrase"
872+ toJSON MatchPhrasePrefix = "phrase_prefix"
873+
874+instance FromJSON MatchQueryType where
875+ parseJSON = withText "MatchQueryType" parse
876+ where parse "phrase" = pure MatchPhrase
877+ parse "phrase_prefix" = pure MatchPhrasePrefix
878+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
879+
274−data MultiMatchQuery =
880+data MultiMatchQuery = MultiMatchQuery
275− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
881+ { multiMatchQueryFields :: [FieldName]
276− , multiMatchQueryString :: QueryString
882+ , multiMatchQueryString :: QueryString
277− , multiMatchQueryOperator :: BooleanOperator
883+ , multiMatchQueryOperator :: BooleanOperator
278− , multiMatchQueryZeroTerms :: ZeroTermsQuery
884+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
279− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
885+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
280− , multiMatchQueryType :: Maybe MultiMatchQueryType
886+ , multiMatchQueryType :: Maybe MultiMatchQueryType
281− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
887+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
282− , multiMatchQueryAnalyzer :: Maybe Analyzer
888+ , multiMatchQueryAnalyzer :: Maybe Analyzer
283− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
889+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
284− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Show)
890+ , multiMatchQueryLenient :: Maybe Lenient
891+ } deriving (Eq, Show)
892+
893+instance ToJSON MultiMatchQuery where
894+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
895+ ztQ tb mmqt cf analyzer maxEx lenient) =
896+ object ["multi_match" .= omitNulls base]
897+ where base = [ "fields" .= fmap toJSON fields
898+ , "query" .= query
899+ , "operator" .= boolOp
900+ , "zero_terms_query" .= ztQ
901+ , "tie_breaker" .= tb
902+ , "type" .= mmqt
903+ , "cutoff_frequency" .= cf
904+ , "analyzer" .= analyzer
905+ , "max_expansions" .= maxEx
906+ , "lenient" .= lenient ]
907+
908+instance FromJSON MultiMatchQuery where
909+ parseJSON = withObject "MultiMatchQuery" parse
910+ where parse raw = do o <- raw .: "multi_match"
911+ MultiMatchQuery
912+ <$> o .:? "fields" .!= []
913+ <*> o .: "query"
914+ <*> o .: "operator"
915+ <*> o .: "zero_terms_query"
916+ <*> o .:? "tie_breaker"
917+ <*> o .:? "type"
918+ <*> o .:? "cutoff_frequency"
919+ <*> o .:? "analyzer"
920+ <*> o .:? "max_expansions"
921+ <*> o .:? "lenient"
285
922
286{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
923{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
287 enabling you to provide only the list of 'FieldName's and 'QueryString' to
924 enabling you to provide only the list of 'FieldName's and 'QueryString' to
@@ -294,12 +931,28 @@ mkMultiMatchQuery matchFields query =
294 Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
931 Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
295
932
296data MultiMatchQueryType =
933data MultiMatchQueryType =
297− MultiMatchBestFields
934+ MultiMatchBestFields
298 | MultiMatchMostFields
935 | MultiMatchMostFields
299 | MultiMatchCrossFields
936 | MultiMatchCrossFields
300 | MultiMatchPhrase
937 | MultiMatchPhrase
301 | MultiMatchPhrasePrefix deriving (Eq, Show)
938 | MultiMatchPhrasePrefix deriving (Eq, Show)
302
939
940+instance ToJSON MultiMatchQueryType where
941+ toJSON MultiMatchBestFields = "best_fields"
942+ toJSON MultiMatchMostFields = "most_fields"
943+ toJSON MultiMatchCrossFields = "cross_fields"
944+ toJSON MultiMatchPhrase = "phrase"
945+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
946+
947+instance FromJSON MultiMatchQueryType where
948+ parseJSON = withText "MultiMatchPhrasePrefix" parse
949+ where parse "best_fields" = pure MultiMatchBestFields
950+ parse "most_fields" = pure MultiMatchMostFields
951+ parse "cross_fields" = pure MultiMatchCrossFields
952+ parse "phrase" = pure MultiMatchPhrase
953+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
954+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
955+
303data BoolQuery =
956data BoolQuery =
304 BoolQuery { boolQueryMustMatch :: [Query]
957 BoolQuery { boolQueryMustMatch :: [Query]
305 , boolQueryFilter :: [Filter]
958 , boolQueryFilter :: [Filter]
@@ -310,6 +963,29 @@ data BoolQuery =
310 , boolQueryDisableCoord :: Maybe DisableCoord
963 , boolQueryDisableCoord :: Maybe DisableCoord
311 } deriving (Eq, Show)
964 } deriving (Eq, Show)
312
965
966+
967+instance ToJSON BoolQuery where
968+ toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
969+ omitNulls base
970+ where base = [ "must" .= mustM
971+ , "filter" .= filterM'
972+ , "must_not" .= notM
973+ , "should" .= shouldM
974+ , "minimum_should_match" .= bqMin
975+ , "boost" .= boost
976+ , "disable_coord" .= disableCoord ]
977+
978+instance FromJSON BoolQuery where
979+ parseJSON = withObject "BoolQuery" parse
980+ where parse o = BoolQuery
981+ <$> o .:? "must" .!= []
982+ <*> o .:? "filter" .!= []
983+ <*> o .:? "must_not" .!= []
984+ <*> o .:? "should" .!= []
985+ <*> o .:? "minimum_should_match"
986+ <*> o .:? "boost"
987+ <*> o .:? "disable_coord"
988+
313mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
989mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
314mkBoolQuery must filt mustNot should =
990mkBoolQuery must filt mustNot should =
315 BoolQuery must filt mustNot should Nothing Nothing Nothing
991 BoolQuery must filt mustNot should Nothing Nothing Nothing
@@ -319,6 +995,19 @@ data BoostingQuery =
319 , negativeQuery :: Query
995 , negativeQuery :: Query
320 , negativeBoost :: Boost } deriving (Eq, Show)
996 , negativeBoost :: Boost } deriving (Eq, Show)
321
997
998+instance ToJSON BoostingQuery where
999+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1000+ object [ "positive" .= bqPositiveQuery
1001+ , "negative" .= bqNegativeQuery
1002+ , "negative_boost" .= bqNegativeBoost ]
1003+
1004+instance FromJSON BoostingQuery where
1005+ parseJSON = withObject "BoostingQuery" parse
1006+ where parse o = BoostingQuery
1007+ <$> o .: "positive"
1008+ <*> o .: "negative"
1009+ <*> o .: "negative_boost"
1010+
322data CommonTermsQuery =
1011data CommonTermsQuery =
323 CommonTermsQuery { commonField :: FieldName
1012 CommonTermsQuery { commonField :: FieldName
324 , commonQuery :: QueryString
1013 , commonQuery :: QueryString
@@ -331,20 +1020,87 @@ data CommonTermsQuery =
331 , commonDisableCoord :: Maybe DisableCoord
1020 , commonDisableCoord :: Maybe DisableCoord
332 } deriving (Eq, Show)
1021 } deriving (Eq, Show)
333
1022
1023+
1024+instance ToJSON CommonTermsQuery where
1025+ toJSON (CommonTermsQuery (FieldName fieldName)
1026+ (QueryString query) cf lfo hfo msm
1027+ boost analyzer disableCoord) =
1028+ object [fieldName .= omitNulls base ]
1029+ where base = [ "query" .= query
1030+ , "cutoff_frequency" .= cf
1031+ , "low_freq_operator" .= lfo
1032+ , "minimum_should_match" .= msm
1033+ , "boost" .= boost
1034+ , "analyzer" .= analyzer
1035+ , "disable_coord" .= disableCoord
1036+ , "high_freq_operator" .= hfo ]
1037+
1038+instance FromJSON CommonTermsQuery where
1039+ parseJSON = withObject "CommonTermsQuery" parse
1040+ where parse = fieldTagged $ \fn o ->
1041+ CommonTermsQuery fn
1042+ <$> o .: "query"
1043+ <*> o .: "cutoff_frequency"
1044+ <*> o .: "low_freq_operator"
1045+ <*> o .: "high_freq_operator"
1046+ <*> o .:? "minimum_should_match"
1047+ <*> o .:? "boost"
1048+ <*> o .:? "analyzer"
1049+ <*> o .:? "disable_coord"
1050+
334data CommonMinimumMatch =
1051data CommonMinimumMatch =
335 CommonMinimumMatchHighLow MinimumMatchHighLow
1052 CommonMinimumMatchHighLow MinimumMatchHighLow
336 | CommonMinimumMatch MinimumMatch
1053 | CommonMinimumMatch MinimumMatch
337 deriving (Eq, Show)
1054 deriving (Eq, Show)
338
1055
1056+
1057+instance ToJSON CommonMinimumMatch where
1058+ toJSON (CommonMinimumMatch mm) = toJSON mm
1059+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1060+ object [ "low_freq" .= lowF
1061+ , "high_freq" .= highF ]
1062+
1063+instance FromJSON CommonMinimumMatch where
1064+ parseJSON v = parseMinimum v
1065+ <|> parseMinimumHighLow v
1066+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
1067+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1068+ MinimumMatchHighLow
1069+ <$> o .: "low_freq"
1070+ <*> o .: "high_freq")
1071+
339data MinimumMatchHighLow =
1072data MinimumMatchHighLow =
340 MinimumMatchHighLow { lowFreq :: MinimumMatch
1073 MinimumMatchHighLow { lowFreq :: MinimumMatch
341 , highFreq :: MinimumMatch } deriving (Eq, Show)
1074 , highFreq :: MinimumMatch } deriving (Eq, Show)
342
1075
343−data ZeroTermsQuery = ZeroTermsNone
1076+data ZeroTermsQuery =
1077+ ZeroTermsNone
344− | ZeroTermsAll deriving (Eq, Show)
1078+ | ZeroTermsAll deriving (Eq, Show)
345
1079
1080+instance ToJSON ZeroTermsQuery where
1081+ toJSON ZeroTermsNone = String "none"
1082+ toJSON ZeroTermsAll = String "all"
1083+
1084+instance FromJSON ZeroTermsQuery where
1085+ parseJSON = withText "ZeroTermsQuery" parse
1086+ where parse "none" = pure ZeroTermsNone
1087+ parse "all" = pure ZeroTermsAll
1088+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1089+
346−data RangeExecution = RangeExecutionIndex
1090+data RangeExecution = RangeExecutionIndex
347− | RangeExecutionFielddata deriving (Eq, Show)
1091+ | RangeExecutionFielddata deriving (Eq, Show)
1092+
1093+-- index for smaller ranges, fielddata for longer ranges
1094+instance ToJSON RangeExecution where
1095+ toJSON RangeExecutionIndex = "index"
1096+ toJSON RangeExecutionFielddata = "fielddata"
1097+
1098+
1099+instance FromJSON RangeExecution where
1100+ parseJSON = withText "RangeExecution" parse
1101+ where parse "index" = pure RangeExecutionIndex
1102+ parse "fielddata" = pure RangeExecutionFielddata
1103+ parse t = error ("Unrecognized RangeExecution " <> show t)
348
1104
349newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
1105newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
350
1106
@@ -352,6 +1108,24 @@ data RegexpFlags = AllRegexpFlags
352 | NoRegexpFlags
1108 | NoRegexpFlags
353 | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
1109 | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
354
1110
1111+instance ToJSON RegexpFlags where
1112+ toJSON AllRegexpFlags = String "ALL"
1113+ toJSON NoRegexpFlags = String "NONE"
1114+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1115+ where flagStrs = map flagStr . nub $ h:fs
1116+ flagStr AnyString = "ANYSTRING"
1117+ flagStr Automaton = "AUTOMATON"
1118+ flagStr Complement = "COMPLEMENT"
1119+ flagStr Empty = "EMPTY"
1120+ flagStr Intersection = "INTERSECTION"
1121+ flagStr Interval = "INTERVAL"
1122+
1123+instance FromJSON RegexpFlags where
1124+ parseJSON = withText "RegexpFlags" parse
1125+ where parse "ALL" = pure AllRegexpFlags
1126+ parse "NONE" = pure NoRegexpFlags
1127+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1128+
355data RegexpFlag = AnyString
1129data RegexpFlag = AnyString
356 | Automaton
1130 | Automaton
357 | Complement
1131 | Complement
@@ -359,6 +1133,16 @@ data RegexpFlag = AnyString
359 | Intersection
1133 | Intersection
360 | Interval deriving (Eq, Show)
1134 | Interval deriving (Eq, Show)
361
1135
1136+instance FromJSON RegexpFlag where
1137+ parseJSON = withText "RegexpFlag" parse
1138+ where parse "ANYSTRING" = pure AnyString
1139+ parse "AUTOMATON" = pure Automaton
1140+ parse "COMPLEMENT" = pure Complement
1141+ parse "EMPTY" = pure Empty
1142+ parse "INTERSECTION" = pure Intersection
1143+ parse "INTERVAL" = pure Interval
1144+ parse f = fail ("Unknown RegexpFlag: " <> show f)
1145+
362newtype LessThan = LessThan Double deriving (Eq, Show)
1146newtype LessThan = LessThan Double deriving (Eq, Show)
363newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
1147newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
364newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
1148newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
@@ -387,6 +1171,78 @@ data RangeValue = RangeDateLte LessThanEqD
387 | RangeDoubleGtLte GreaterThan LessThanEq
1171 | RangeDoubleGtLte GreaterThan LessThanEq
388 deriving (Eq, Show)
1172 deriving (Eq, Show)
389
1173
1174+
1175+parseRangeValue :: ( FromJSON t4
1176+ , FromJSON t3
1177+ , FromJSON t2
1178+ , FromJSON t1
1179+ )
1180+ => (t3 -> t5)
1181+ -> (t1 -> t6)
1182+ -> (t4 -> t7)
1183+ -> (t2 -> t8)
1184+ -> (t5 -> t6 -> b)
1185+ -> (t7 -> t6 -> b)
1186+ -> (t5 -> t8 -> b)
1187+ -> (t7 -> t8 -> b)
1188+ -> (t5 -> b)
1189+ -> (t6 -> b)
1190+ -> (t7 -> b)
1191+ -> (t8 -> b)
1192+ -> Parser b
1193+ -> Object
1194+ -> Parser b
1195+parseRangeValue mkGt mkLt mkGte mkLte
1196+ fGtLt fGteLt fGtLte fGteLte
1197+ fGt fLt fGte fLte nada o = do
1198+ lt <- o .:? "lt"
1199+ lte <- o .:? "lte"
1200+ gt <- o .:? "gt"
1201+ gte <- o .:? "gte"
1202+ case (lt, lte, gt, gte) of
1203+ (Just a, _, Just b, _) ->
1204+ return (fGtLt (mkGt b) (mkLt a))
1205+ (Just a, _, _, Just b) ->
1206+ return (fGteLt (mkGte b) (mkLt a))
1207+ (_, Just a, Just b, _) ->
1208+ return (fGtLte (mkGt b) (mkLte a))
1209+ (_, Just a, _, Just b) ->
1210+ return (fGteLte (mkGte b) (mkLte a))
1211+ (_, _, Just a, _) ->
1212+ return (fGt (mkGt a))
1213+ (Just a, _, _, _) ->
1214+ return (fLt (mkLt a))
1215+ (_, _, _, Just a) ->
1216+ return (fGte (mkGte a))
1217+ (_, Just a, _, _) ->
1218+ return (fLte (mkLte a))
1219+ (Nothing, Nothing, Nothing, Nothing) ->
1220+ nada
1221+
1222+
1223+instance FromJSON RangeValue where
1224+ parseJSON = withObject "RangeValue" parse
1225+ where parse o = parseDate o
1226+ <|> parseDouble o
1227+ parseDate o =
1228+ parseRangeValue
1229+ GreaterThanD LessThanD
1230+ GreaterThanEqD LessThanEqD
1231+ RangeDateGtLt RangeDateGteLt
1232+ RangeDateGtLte RangeDateGteLte
1233+ RangeDateGt RangeDateLt
1234+ RangeDateGte RangeDateLte
1235+ mzero o
1236+ parseDouble o =
1237+ parseRangeValue
1238+ GreaterThan LessThan
1239+ GreaterThanEq LessThanEq
1240+ RangeDoubleGtLt RangeDoubleGteLt
1241+ RangeDoubleGtLte RangeDoubleGteLte
1242+ RangeDoubleGt RangeDoubleLt
1243+ RangeDoubleGte RangeDoubleLte
1244+ mzero o
1245+
390rangeValueToPair :: RangeValue -> [Pair]
1246rangeValueToPair :: RangeValue -> [Pair]
391rangeValueToPair rv = case rv of
1247rangeValueToPair rv = case rv of
392 RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1248 RangeDateLte (LessThanEqD t) -> ["lte" .= t]
@@ -409,21 +1265,82 @@ rangeValueToPair rv = case rv of
409data Term = Term { termField :: Text
1265data Term = Term { termField :: Text
410 , termValue :: Text } deriving (Eq, Show)
1266 , termValue :: Text } deriving (Eq, Show)
411
1267
1268+instance ToJSON Term where
1269+ toJSON (Term field value) = object ["term" .= object
1270+ [field .= value]]
1271+
1272+instance FromJSON Term where
1273+ parseJSON = withObject "Term" parse
1274+ where parse o = do termObj <- o .: "term"
1275+ case HM.toList termObj of
1276+ [(fn, v)] -> Term fn <$> parseJSON v
1277+ _ -> fail "Expected object with 1 field-named key"
1278+
412data BoolMatch = MustMatch Term Cache
1279data BoolMatch = MustMatch Term Cache
413 | MustNotMatch Term Cache
1280 | MustNotMatch Term Cache
414 | ShouldMatch [Term] Cache deriving (Eq, Show)
1281 | ShouldMatch [Term] Cache deriving (Eq, Show)
415
1282
1283+
1284+instance ToJSON BoolMatch where
1285+ toJSON (MustMatch term cache) = object ["must" .= term,
1286+ "_cache" .= cache]
1287+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1288+ "_cache" .= cache]
1289+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1290+ "_cache" .= cache]
1291+
1292+instance FromJSON BoolMatch where
1293+ parseJSON = withObject "BoolMatch" parse
1294+ where parse o = mustMatch `taggedWith` "must"
1295+ <|> mustNotMatch `taggedWith` "must_not"
1296+ <|> shouldMatch `taggedWith` "should"
1297+ where taggedWith parser k = parser =<< o .: k
1298+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1299+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1300+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
1301+
416-- "memory" or "indexed"
1302-- "memory" or "indexed"
417data GeoFilterType = GeoFilterMemory
1303data GeoFilterType = GeoFilterMemory
418 | GeoFilterIndexed deriving (Eq, Show)
1304 | GeoFilterIndexed deriving (Eq, Show)
419
1305
1306+instance ToJSON GeoFilterType where
1307+ toJSON GeoFilterMemory = String "memory"
1308+ toJSON GeoFilterIndexed = String "indexed"
1309+
1310+instance FromJSON GeoFilterType where
1311+ parseJSON = withText "GeoFilterType" parse
1312+ where parse "memory" = pure GeoFilterMemory
1313+ parse "indexed" = pure GeoFilterIndexed
1314+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1315+
420data LatLon = LatLon { lat :: Double
1316data LatLon = LatLon { lat :: Double
421 , lon :: Double } deriving (Eq, Show)
1317 , lon :: Double } deriving (Eq, Show)
422
1318
1319+instance ToJSON LatLon where
1320+ toJSON (LatLon lLat lLon) =
1321+ object ["lat" .= lLat
1322+ , "lon" .= lLon]
1323+
1324+instance FromJSON LatLon where
1325+ parseJSON = withObject "LatLon" parse
1326+ where parse o = LatLon <$> o .: "lat"
1327+ <*> o .: "lon"
1328+
423data GeoBoundingBox =
1329data GeoBoundingBox =
424 GeoBoundingBox { topLeft :: LatLon
1330 GeoBoundingBox { topLeft :: LatLon
425 , bottomRight :: LatLon } deriving (Eq, Show)
1331 , bottomRight :: LatLon } deriving (Eq, Show)
426
1332
1333+instance ToJSON GeoBoundingBox where
1334+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1335+ object ["top_left" .= gbbTopLeft
1336+ , "bottom_right" .= gbbBottomRight]
1337+
1338+instance FromJSON GeoBoundingBox where
1339+ parseJSON = withObject "GeoBoundingBox" parse
1340+ where parse o = GeoBoundingBox
1341+ <$> o .: "top_left"
1342+ <*> o .: "bottom_right"
1343+
427data GeoBoundingBoxConstraint =
1344data GeoBoundingBoxConstraint =
428 GeoBoundingBoxConstraint { geoBBField :: FieldName
1345 GeoBoundingBoxConstraint { geoBBField :: FieldName
429 , constraintBox :: GeoBoundingBox
1346 , constraintBox :: GeoBoundingBox
@@ -431,6 +1348,22 @@ data GeoBoundingBoxConstraint =
431 , geoType :: GeoFilterType
1348 , geoType :: GeoFilterType
432 } deriving (Eq, Show)
1349 } deriving (Eq, Show)
433
1350
1351+instance ToJSON GeoBoundingBoxConstraint where
1352+ toJSON (GeoBoundingBoxConstraint
1353+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1354+ object [gbbcGeoBBField .= gbbcConstraintBox
1355+ , "_cache" .= cache
1356+ , "type" .= type']
1357+
1358+instance FromJSON GeoBoundingBoxConstraint where
1359+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
1360+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1361+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1362+ <$> parseJSON v
1363+ <*> o .:? "_cache" .!= defaultCache
1364+ <*> o .: "type"
1365+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1366+
434data GeoPoint =
1367data GeoPoint =
435 GeoPoint { geoField :: FieldName
1368 GeoPoint { geoField :: FieldName
436 , latLon :: LatLon} deriving (Eq, Show)
1369 , latLon :: LatLon} deriving (Eq, Show)
@@ -449,27 +1382,96 @@ data DistanceUnit = Miles
449 | Millimeters
1382 | Millimeters
450 | NauticalMiles deriving (Eq, Show)
1383 | NauticalMiles deriving (Eq, Show)
451
1384
1385+instance ToJSON DistanceUnit where
1386+ toJSON Miles = String "mi"
1387+ toJSON Yards = String "yd"
1388+ toJSON Feet = String "ft"
1389+ toJSON Inches = String "in"
1390+ toJSON Kilometers = String "km"
1391+ toJSON Meters = String "m"
1392+ toJSON Centimeters = String "cm"
1393+ toJSON Millimeters = String "mm"
1394+ toJSON NauticalMiles = String "nmi"
1395+
1396+instance FromJSON DistanceUnit where
1397+ parseJSON = withText "DistanceUnit" parse
1398+ where parse "mi" = pure Miles
1399+ parse "yd" = pure Yards
1400+ parse "ft" = pure Feet
1401+ parse "in" = pure Inches
1402+ parse "km" = pure Kilometers
1403+ parse "m" = pure Meters
1404+ parse "cm" = pure Centimeters
1405+ parse "mm" = pure Millimeters
1406+ parse "nmi" = pure NauticalMiles
1407+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1408+
452data DistanceType = Arc
1409data DistanceType = Arc
453 | SloppyArc -- doesn't exist <1.0
1410 | SloppyArc -- doesn't exist <1.0
454 | Plane deriving (Eq, Show)
1411 | Plane deriving (Eq, Show)
455
1412
1413+instance ToJSON DistanceType where
1414+ toJSON Arc = String "arc"
1415+ toJSON SloppyArc = String "sloppy_arc"
1416+ toJSON Plane = String "plane"
1417+
1418+instance FromJSON DistanceType where
1419+ parseJSON = withText "DistanceType" parse
1420+ where parse "arc" = pure Arc
1421+ parse "sloppy_arc" = pure SloppyArc
1422+ parse "plane" = pure Plane
1423+ parse t = fail ("Unrecognized DistanceType: " <> show t)
1424+
456data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1425data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
457 | NoOptimizeBbox deriving (Eq, Show)
1426 | NoOptimizeBbox deriving (Eq, Show)
458
1427
1428+
1429+instance ToJSON OptimizeBbox where
1430+ toJSON NoOptimizeBbox = String "none"
1431+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
1432+
1433+instance FromJSON OptimizeBbox where
1434+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1435+ <|> parseOptimize v
1436+ where parseNoOptimize "none" = pure NoOptimizeBbox
1437+ parseNoOptimize _ = mzero
1438+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1439+
459data Distance =
1440data Distance =
460 Distance { coefficient :: Double
1441 Distance { coefficient :: Double
461 , unit :: DistanceUnit } deriving (Eq, Show)
1442 , unit :: DistanceUnit } deriving (Eq, Show)
462
1443
1444+
1445+instance ToJSON Distance where
1446+ toJSON (Distance dCoefficient dUnit) =
1447+ String boltedTogether where
1448+ coefText = showText dCoefficient
1449+ (String unitText) = toJSON dUnit
1450+ boltedTogether = mappend coefText unitText
1451+
1452+instance FromJSON Distance where
1453+ parseJSON = withText "Distance" parse
1454+ where parse t = Distance <$> parseCoeff nT
1455+ <*> parseJSON (String unitT)
1456+ where (nT, unitT) = T.span validForNumber t
1457+ -- may be a better way to do this
1458+ validForNumber '-' = True
1459+ validForNumber '.' = True
1460+ validForNumber 'e' = True
1461+ validForNumber c = isNumber c
1462+ parseCoeff "" = fail "Empty string cannot be parsed as number"
1463+ parseCoeff s = return (read (T.unpack s))
1464+
463−data DistanceRange =
1465+data DistanceRange =
464− DistanceRange { distanceFrom :: Distance
1466+ DistanceRange { distanceFrom :: Distance
465− , distanceTo :: Distance } deriving (Eq, Show)
1467+ , distanceTo :: Distance } deriving (Eq, Show)
466−
1468+
467−type TemplateQueryKey = Text
1469+type TemplateQueryKey = Text
468−type TemplateQueryValue = Text
1470+type TemplateQueryValue = Text
469−
1471+
470−newtype TemplateQueryKeyValuePairs =
1472+newtype TemplateQueryKeyValuePairs =
471− TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1473+ TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
472− deriving (Eq, Show)
1474+ deriving (Eq, Show)
473
1475
474instance ToJSON TemplateQueryKeyValuePairs where
1476instance ToJSON TemplateQueryKeyValuePairs where
475 toJSON (TemplateQueryKeyValuePairs x) =
1477 toJSON (TemplateQueryKeyValuePairs x) =
@@ -505,6 +1507,16 @@ instance FromJSON TemplateQueryInline where
505-}
1507-}
506data BooleanOperator = And | Or deriving (Eq, Show)
1508data BooleanOperator = And | Or deriving (Eq, Show)
507
1509
1510+instance ToJSON BooleanOperator where
1511+ toJSON And = String "and"
1512+ toJSON Or = String "or"
1513+
1514+instance FromJSON BooleanOperator where
1515+ parseJSON = withText "BooleanOperator" parse
1516+ where parse "and" = pure And
1517+ parse "or" = pure Or
1518+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
1519+
508{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
1520{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
509 'Query's cannot be cached.
1521 'Query's cannot be cached.
510-}
1522-}
@@ -579,1007 +1591,10 @@ functionScoreFunctionsPair (FunctionScoreSingle fn)
579functionScoreFunctionsPair (FunctionScoreMultiple componentFns) =
1591functionScoreFunctionsPair (FunctionScoreMultiple componentFns) =
580 ("functions", toJSON componentFns)
1592 ("functions", toJSON componentFns)
581
1593
582−
583−instance ToJSON Query where
584− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
585− object [ "term" .=
586− object [termQueryField .= object merged]]
587− where
588− base = [ "value" .= termQueryValue ]
589− boosted = maybe [] (return . ("boost" .=)) boost
590− merged = mappend base boosted
591−
592− toJSON (TermsQuery fieldName terms) =
593− object [ "terms" .= object conjoined ]
594− where conjoined = [fieldName .= terms]
595−
596− toJSON (IdsQuery idsQueryMappingName docIds) =
597− object [ "ids" .= object conjoined ]
598− where conjoined = [ "type" .= idsQueryMappingName
599− , "values" .= fmap toJSON docIds ]
600−
601− toJSON (QueryQueryStringQuery qQueryStringQuery) =
602− object [ "query_string" .= qQueryStringQuery ]
603−
604− toJSON (QueryMatchQuery matchQuery) =
605− object [ "match" .= matchQuery ]
606−
607− toJSON (QueryMultiMatchQuery multiMatchQuery) =
608− toJSON multiMatchQuery
609−
610− toJSON (QueryBoolQuery boolQuery) =
611− object [ "bool" .= boolQuery ]
612−
613− toJSON (QueryBoostingQuery boostingQuery) =
614− object [ "boosting" .= boostingQuery ]
615−
616− toJSON (QueryCommonTermsQuery commonTermsQuery) =
617− object [ "common" .= commonTermsQuery ]
618−
619− toJSON (ConstantScoreQuery query boost) =
620− object ["constant_score" .= object ["query" .= query
621− , "boost" .= boost]]
622−
623− toJSON (QueryFunctionScoreQuery functionScoreQuery) =
624− object [ "function_score" .= functionScoreQuery ]
625−
626− toJSON (QueryDisMaxQuery disMaxQuery) =
627− object [ "dis_max" .= disMaxQuery ]
628−
629− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
630− object [ "fuzzy_like_this" .= fuzzyQuery ]
631−
632− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
633− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
634−
635− toJSON (QueryFuzzyQuery fuzzyQuery) =
636− object [ "fuzzy" .= fuzzyQuery ]
637−
638− toJSON (QueryHasChildQuery childQuery) =
639− object [ "has_child" .= childQuery ]
640−
641− toJSON (QueryHasParentQuery parentQuery) =
642− object [ "has_parent" .= parentQuery ]
643−
644− toJSON (QueryIndicesQuery qIndicesQuery) =
645− object [ "indices" .= qIndicesQuery ]
646−
647− toJSON (MatchAllQuery boost) =
648− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
649−
650− toJSON (QueryMoreLikeThisQuery query) =
651− object [ "more_like_this" .= query ]
652−
653− toJSON (QueryMoreLikeThisFieldQuery query) =
654− object [ "more_like_this_field" .= query ]
655−
656− toJSON (QueryNestedQuery query) =
657− object [ "nested" .= query ]
658−
659− toJSON (QueryPrefixQuery query) =
660− object [ "prefix" .= query ]
661−
662− toJSON (QueryRangeQuery query) =
663− object [ "range" .= query ]
664−
665− toJSON (QueryRegexpQuery query) =
666− object [ "regexp" .= query ]
667−
668− toJSON (QuerySimpleQueryStringQuery query) =
669− object [ "simple_query_string" .= query ]
670−
671− toJSON (QueryExistsQuery (FieldName fieldName)) =
672− object ["exists" .= object
673− ["field" .= fieldName]
674− ]
675− toJSON QueryMatchNoneQuery =
676− object ["match_none" .= object []]
677−
678− toJSON (QueryTemplateQueryInline templateQuery) =
679− object [ "template" .= templateQuery ]
680−
681−instance FromJSON Query where
682− parseJSON v = withObject "Query" parse v
683− where parse o = termQuery `taggedWith` "term"
684− <|> termsQuery `taggedWith` "terms"
685− <|> idsQuery `taggedWith` "ids"
686− <|> queryQueryStringQuery `taggedWith` "query_string"
687− <|> queryMatchQuery `taggedWith` "match"
688− <|> queryMultiMatchQuery
689− <|> queryBoolQuery `taggedWith` "bool"
690− <|> queryBoostingQuery `taggedWith` "boosting"
691− <|> queryCommonTermsQuery `taggedWith` "common"
692− <|> constantScoreQuery `taggedWith` "constant_score"
693− <|> queryFunctionScoreQuery `taggedWith` "function_score"
694− <|> queryDisMaxQuery `taggedWith` "dis_max"
695− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
696− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
697− <|> queryFuzzyQuery `taggedWith` "fuzzy"
698− <|> queryHasChildQuery `taggedWith` "has_child"
699− <|> queryHasParentQuery `taggedWith` "has_parent"
700− <|> queryIndicesQuery `taggedWith` "indices"
701− <|> matchAllQuery `taggedWith` "match_all"
702− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
703− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
704− <|> queryNestedQuery `taggedWith` "nested"
705− <|> queryPrefixQuery `taggedWith` "prefix"
706− <|> queryRangeQuery `taggedWith` "range"
707− <|> queryRegexpQuery `taggedWith` "regexp"
708− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
709− <|> queryTemplateQueryInline `taggedWith` "template"
710− where taggedWith parser k = parser =<< o .: k
711− termQuery = fieldTagged $ \(FieldName fn) o ->
712− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
713− termsQuery o = case HM.toList o of
714− [(fn, vs)] -> do vals <- parseJSON vs
715− case vals of
716− x:xs -> return (TermsQuery fn (x :| xs))
717− _ -> fail "Expected non empty list of values"
718− _ -> fail "Expected object with 1 field-named key"
719− idsQuery o = IdsQuery <$> o .: "type"
720− <*> o .: "values"
721− queryQueryStringQuery = pure . QueryQueryStringQuery
722− queryMatchQuery = pure . QueryMatchQuery
723− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
724− queryBoolQuery = pure . QueryBoolQuery
725− queryBoostingQuery = pure . QueryBoostingQuery
726− queryCommonTermsQuery = pure . QueryCommonTermsQuery
727− constantScoreQuery o = case HM.lookup "query" o of
728− Just x -> ConstantScoreQuery <$> parseJSON x
729− <*> o .: "boost"
730− _ -> fail "Does not appear to be a ConstantScoreQuery"
731− queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
732− queryDisMaxQuery = pure . QueryDisMaxQuery
733− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
734− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
735− queryFuzzyQuery = pure . QueryFuzzyQuery
736− queryHasChildQuery = pure . QueryHasChildQuery
737− queryHasParentQuery = pure . QueryHasParentQuery
738− queryIndicesQuery = pure . QueryIndicesQuery
739− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
740− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
741− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
742− queryNestedQuery = pure . QueryNestedQuery
743− queryPrefixQuery = pure . QueryPrefixQuery
744− queryRangeQuery = pure . QueryRangeQuery
745− queryRegexpQuery = pure . QueryRegexpQuery
746− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
747− -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
748− queryTemplateQueryInline = pure . QueryTemplateQueryInline
749−
750fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
1594fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
751fieldTagged f o = case HM.toList o of
1595fieldTagged f o = case HM.toList o of
752 [(k, Object o')] -> f (FieldName k) o'
1596 [(k, Object o')] -> f (FieldName k) o'
753 _ -> fail "Expected object with 1 field-named key"
1597 _ -> fail "Expected object with 1 field-named key"
754
1598
755−instance ToJSON SimpleQueryStringQuery where
756− toJSON SimpleQueryStringQuery {..} =
757− omitNulls (base ++ maybeAdd)
758− where base = [ "query" .= simpleQueryStringQuery ]
759− maybeAdd = [ "fields" .= simpleQueryStringField
760− , "default_operator" .= simpleQueryStringOperator
761− , "analyzer" .= simpleQueryStringAnalyzer
762− , "flags" .= simpleQueryStringFlags
763− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
764− , "locale" .= simpleQueryStringLocale ]
765−
766−instance FromJSON SimpleQueryStringQuery where
767− parseJSON = withObject "SimpleQueryStringQuery" parse
768− where parse o = SimpleQueryStringQuery <$> o .: "query"
769− <*> o .:? "fields"
770− <*> o .:? "default_operator"
771− <*> o .:? "analyzer"
772− <*> (parseFlags <$> o .:? "flags")
773− <*> o .:? "lowercase_expanded_terms"
774− <*> o .:? "locale"
775− parseFlags (Just (x:xs)) = Just (x :| xs)
776− parseFlags _ = Nothing
777−
778−instance ToJSON FieldOrFields where
779− toJSON (FofField fieldName) =
780− toJSON fieldName
781− toJSON (FofFields fieldNames) =
782− toJSON fieldNames
783−
784−instance FromJSON FieldOrFields where
785− parseJSON v = FofField <$> parseJSON v
786− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
787−
788−instance ToJSON SimpleQueryFlag where
789− toJSON SimpleQueryAll = "ALL"
790− toJSON SimpleQueryNone = "NONE"
791− toJSON SimpleQueryAnd = "AND"
792− toJSON SimpleQueryOr = "OR"
793− toJSON SimpleQueryPrefix = "PREFIX"
794− toJSON SimpleQueryPhrase = "PHRASE"
795− toJSON SimpleQueryPrecedence = "PRECEDENCE"
796− toJSON SimpleQueryEscape = "ESCAPE"
797− toJSON SimpleQueryWhitespace = "WHITESPACE"
798− toJSON SimpleQueryFuzzy = "FUZZY"
799− toJSON SimpleQueryNear = "NEAR"
800− toJSON SimpleQuerySlop = "SLOP"
801−
802−instance FromJSON SimpleQueryFlag where
803− parseJSON = withText "SimpleQueryFlag" parse
804− where parse "ALL" = pure SimpleQueryAll
805− parse "NONE" = pure SimpleQueryNone
806− parse "AND" = pure SimpleQueryAnd
807− parse "OR" = pure SimpleQueryOr
808− parse "PREFIX" = pure SimpleQueryPrefix
809− parse "PHRASE" = pure SimpleQueryPhrase
810− parse "PRECEDENCE" = pure SimpleQueryPrecedence
811− parse "ESCAPE" = pure SimpleQueryEscape
812− parse "WHITESPACE" = pure SimpleQueryWhitespace
813− parse "FUZZY" = pure SimpleQueryFuzzy
814− parse "NEAR" = pure SimpleQueryNear
815− parse "SLOP" = pure SimpleQuerySlop
816− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
817−
818−instance ToJSON RegexpQuery where
819− toJSON (RegexpQuery (FieldName rqQueryField)
820− (Regexp regexpQueryQuery) rqQueryFlags
821− rqQueryBoost) =
822− object [ rqQueryField .= omitNulls base ]
823− where base = [ "value" .= regexpQueryQuery
824− , "flags" .= rqQueryFlags
825− , "boost" .= rqQueryBoost ]
826−
827−instance FromJSON RegexpQuery where
828− parseJSON = withObject "RegexpQuery" parse
829− where parse = fieldTagged $ \fn o ->
830− RegexpQuery fn
831− <$> o .: "value"
832− <*> o .: "flags"
833− <*> o .:? "boost"
834−
835−instance ToJSON QueryStringQuery where
836− toJSON (QueryStringQuery qsQueryString
837− qsDefaultField qsOperator
838− qsAnalyzer qsAllowWildcard
839− qsLowercaseExpanded qsEnablePositionIncrements
840− qsFuzzyMaxExpansions qsFuzziness
841− qsFuzzyPrefixLength qsPhraseSlop
842− qsBoost qsAnalyzeWildcard
843− qsGeneratePhraseQueries qsMinimumShouldMatch
844− qsLenient qsLocale) =
845− omitNulls base
846− where
847− base = [ "query" .= qsQueryString
848− , "default_field" .= qsDefaultField
849− , "default_operator" .= qsOperator
850− , "analyzer" .= qsAnalyzer
851− , "allow_leading_wildcard" .= qsAllowWildcard
852− , "lowercase_expanded_terms" .= qsLowercaseExpanded
853− , "enable_position_increments" .= qsEnablePositionIncrements
854− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
855− , "fuzziness" .= qsFuzziness
856− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
857− , "phrase_slop" .= qsPhraseSlop
858− , "boost" .= qsBoost
859− , "analyze_wildcard" .= qsAnalyzeWildcard
860− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
861− , "minimum_should_match" .= qsMinimumShouldMatch
862− , "lenient" .= qsLenient
863− , "locale" .= qsLocale ]
864−
865−instance FromJSON QueryStringQuery where
866− parseJSON = withObject "QueryStringQuery" parse
867− where parse o = QueryStringQuery
868− <$> o .: "query"
869− <*> o .:? "default_field"
870− <*> o .:? "default_operator"
871− <*> o .:? "analyzer"
872− <*> o .:? "allow_leading_wildcard"
873− <*> o .:? "lowercase_expanded_terms"
874− <*> o .:? "enable_position_increments"
875− <*> o .:? "fuzzy_max_expansions"
876− <*> o .:? "fuzziness"
877− <*> o .:? "fuzzy_prefix_length"
878− <*> o .:? "phrase_slop"
879− <*> o .:? "boost"
880− <*> o .:? "analyze_wildcard"
881− <*> o .:? "auto_generate_phrase_queries"
882− <*> o .:? "minimum_should_match"
883− <*> o .:? "lenient"
884− <*> o .:? "locale"
885−
886−instance ToJSON RangeQuery where
887− toJSON (RangeQuery (FieldName fieldName) range boost) =
888− object [ fieldName .= object conjoined ]
889− where
890− conjoined = ("boost" .= boost) : rangeValueToPair range
891−
892−instance FromJSON RangeQuery where
893− parseJSON = withObject "RangeQuery" parse
894− where parse = fieldTagged $ \fn o ->
895− RangeQuery fn
896− <$> parseJSON (Object o)
897− <*> o .: "boost"
898−
899−parseRangeValue :: ( FromJSON t4
900− , FromJSON t3
901− , FromJSON t2
902− , FromJSON t1
903− )
904− => (t3 -> t5)
905− -> (t1 -> t6)
906− -> (t4 -> t7)
907− -> (t2 -> t8)
908− -> (t5 -> t6 -> b)
909− -> (t7 -> t6 -> b)
910− -> (t5 -> t8 -> b)
911− -> (t7 -> t8 -> b)
912− -> (t5 -> b)
913− -> (t6 -> b)
914− -> (t7 -> b)
915− -> (t8 -> b)
916− -> Parser b
917− -> Object
918− -> Parser b
919−parseRangeValue mkGt mkLt mkGte mkLte
920− fGtLt fGteLt fGtLte fGteLte
921− fGt fLt fGte fLte nada o = do
922− lt <- o .:? "lt"
923− lte <- o .:? "lte"
924− gt <- o .:? "gt"
925− gte <- o .:? "gte"
926− case (lt, lte, gt, gte) of
927− (Just a, _, Just b, _) ->
928− return (fGtLt (mkGt b) (mkLt a))
929− (Just a, _, _, Just b) ->
930− return (fGteLt (mkGte b) (mkLt a))
931− (_, Just a, Just b, _) ->
932− return (fGtLte (mkGt b) (mkLte a))
933− (_, Just a, _, Just b) ->
934− return (fGteLte (mkGte b) (mkLte a))
935− (_, _, Just a, _) ->
936− return (fGt (mkGt a))
937− (Just a, _, _, _) ->
938− return (fLt (mkLt a))
939− (_, _, _, Just a) ->
940− return (fGte (mkGte a))
941− (_, Just a, _, _) ->
942− return (fLte (mkLte a))
943− (Nothing, Nothing, Nothing, Nothing) ->
944− nada
945−
946−
947−instance FromJSON RangeValue where
948− parseJSON = withObject "RangeValue" parse
949− where parse o = parseDate o
950− <|> parseDouble o
951− parseDate o =
952− parseRangeValue
953− GreaterThanD LessThanD
954− GreaterThanEqD LessThanEqD
955− RangeDateGtLt RangeDateGteLt
956− RangeDateGtLte RangeDateGteLte
957− RangeDateGt RangeDateLt
958− RangeDateGte RangeDateLte
959− mzero o
960− parseDouble o =
961− parseRangeValue
962− GreaterThan LessThan
963− GreaterThanEq LessThanEq
964− RangeDoubleGtLt RangeDoubleGteLt
965− RangeDoubleGtLte RangeDoubleGteLte
966− RangeDoubleGt RangeDoubleLt
967− RangeDoubleGte RangeDoubleLte
968− mzero o
969−
970−instance ToJSON PrefixQuery where
971− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
972− object [ fieldName .= omitNulls base ]
973− where base = [ "value" .= queryValue
974− , "boost" .= boost ]
975−
976−instance FromJSON PrefixQuery where
977− parseJSON = withObject "PrefixQuery" parse
978− where parse = fieldTagged $ \fn o ->
979− PrefixQuery fn
980− <$> o .: "value"
981− <*> o .:? "boost"
982−
983−instance ToJSON NestedQuery where
984− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
985− object [ "path" .= nqPath
986− , "score_mode" .= nqScoreType
987− , "query" .= nqQuery ]
988−
989−instance FromJSON NestedQuery where
990− parseJSON = withObject "NestedQuery" parse
991− where parse o = NestedQuery
992− <$> o .: "path"
993− <*> o .: "score_mode"
994− <*> o .: "query"
995−
996−instance ToJSON MoreLikeThisFieldQuery where
997− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
998− percent mtf mqt stopwords mindf maxdf
999− minwl maxwl boostTerms boost analyzer) =
1000− object [ fieldName .= omitNulls base ]
1001− where base = [ "like_text" .= text
1002− , "percent_terms_to_match" .= percent
1003− , "min_term_freq" .= mtf
1004− , "max_query_terms" .= mqt
1005− , "stop_words" .= stopwords
1006− , "min_doc_freq" .= mindf
1007− , "max_doc_freq" .= maxdf
1008− , "min_word_length" .= minwl
1009− , "max_word_length" .= maxwl
1010− , "boost_terms" .= boostTerms
1011− , "boost" .= boost
1012− , "analyzer" .= analyzer ]
1013−
1014−instance FromJSON MoreLikeThisFieldQuery where
1015− parseJSON = withObject "MoreLikeThisFieldQuery" parse
1016− where parse = fieldTagged $ \fn o ->
1017− MoreLikeThisFieldQuery
1018− <$> o .: "like_text"
1019− <*> pure fn
1020− <*> o .:? "percent_terms_to_match"
1021− <*> o .:? "min_term_freq"
1022− <*> o .:? "max_query_terms"
1023− -- <*> (optionalNE =<< o .:? "stop_words")
1024− <*> o .:? "stop_words"
1025− <*> o .:? "min_doc_freq"
1026− <*> o .:? "max_doc_freq"
1027− <*> o .:? "min_word_length"
1028− <*> o .:? "max_word_length"
1029− <*> o .:? "boost_terms"
1030− <*> o .:? "boost"
1031− <*> o .:? "analyzer"
1032− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
1033−
1034−instance ToJSON MoreLikeThisQuery where
1035− toJSON (MoreLikeThisQuery text fields percent
1036− mtf mqt stopwords mindf maxdf
1037− minwl maxwl boostTerms boost analyzer) =
1038− omitNulls base
1039− where base = [ "like_text" .= text
1040− , "fields" .= fields
1041− , "percent_terms_to_match" .= percent
1042− , "min_term_freq" .= mtf
1043− , "max_query_terms" .= mqt
1044− , "stop_words" .= stopwords
1045− , "min_doc_freq" .= mindf
1046− , "max_doc_freq" .= maxdf
1047− , "min_word_length" .= minwl
1048− , "max_word_length" .= maxwl
1049− , "boost_terms" .= boostTerms
1050− , "boost" .= boost
1051− , "analyzer" .= analyzer ]
1052−
1053−instance FromJSON MoreLikeThisQuery where
1054− parseJSON = withObject "MoreLikeThisQuery" parse
1055− where parse o = MoreLikeThisQuery
1056− <$> o .: "like_text"
1057− -- <*> (optionalNE =<< o .:? "fields")
1058− <*> o .:? "fields"
1059− <*> o .:? "percent_terms_to_match"
1060− <*> o .:? "min_term_freq"
1061− <*> o .:? "max_query_terms"
1062− -- <*> (optionalNE =<< o .:? "stop_words")
1063− <*> o .:? "stop_words"
1064− <*> o .:? "min_doc_freq"
1065− <*> o .:? "max_doc_freq"
1066− <*> o .:? "min_word_length"
1067− <*> o .:? "max_word_length"
1068− <*> o .:? "boost_terms"
1069− <*> o .:? "boost"
1070− <*> o .:? "analyzer"
1071− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
1072−
1073−instance ToJSON IndicesQuery where
1074− toJSON (IndicesQuery indices query noMatch) =
1075− omitNulls [ "indices" .= indices
1076− , "no_match_query" .= noMatch
1077− , "query" .= query ]
1078−
1079−instance FromJSON IndicesQuery where
1080− parseJSON = withObject "IndicesQuery" parse
1081− where parse o = IndicesQuery
1082− <$> o .:? "indices" .!= []
1083− <*> o .: "query"
1084− <*> o .:? "no_match_query"
1085−
1086−instance ToJSON HasParentQuery where
1087− toJSON (HasParentQuery queryType query scoreType) =
1088− omitNulls [ "parent_type" .= queryType
1089− , "score_type" .= scoreType
1090− , "query" .= query ]
1091−
1092−instance FromJSON HasParentQuery where
1093− parseJSON = withObject "HasParentQuery" parse
1094− where parse o = HasParentQuery
1095− <$> o .: "parent_type"
1096− <*> o .: "query"
1097− <*> o .:? "score_type"
1098−
1099−instance ToJSON HasChildQuery where
1100− toJSON (HasChildQuery queryType query scoreType) =
1101− omitNulls [ "query" .= query
1102− , "score_type" .= scoreType
1103− , "type" .= queryType ]
1104−
1105−instance FromJSON HasChildQuery where
1106− parseJSON = withObject "HasChildQuery" parse
1107− where parse o = HasChildQuery
1108− <$> o .: "type"
1109− <*> o .: "query"
1110− <*> o .:? "score_type"
1111−
1112−instance ToJSON FuzzyQuery where
1113− toJSON (FuzzyQuery (FieldName fieldName) queryText
1114− prefixLength maxEx fuzziness boost) =
1115− object [ fieldName .= omitNulls base ]
1116− where base = [ "value" .= queryText
1117− , "fuzziness" .= fuzziness
1118− , "prefix_length" .= prefixLength
1119− , "boost" .= boost
1120− , "max_expansions" .= maxEx ]
1121−
1122−instance FromJSON FuzzyQuery where
1123− parseJSON = withObject "FuzzyQuery" parse
1124− where parse = fieldTagged $ \fn o ->
1125− FuzzyQuery fn
1126− <$> o .: "value"
1127− <*> o .: "prefix_length"
1128− <*> o .: "max_expansions"
1129− <*> o .: "fuzziness"
1130− <*> o .:? "boost"
1131−
1132−instance ToJSON FuzzyLikeFieldQuery where
1133− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
1134− fieldText maxTerms ignoreFreq fuzziness prefixLength
1135− boost analyzer) =
1136− object [ fieldName .=
1137− omitNulls [ "like_text" .= fieldText
1138− , "max_query_terms" .= maxTerms
1139− , "ignore_tf" .= ignoreFreq
1140− , "fuzziness" .= fuzziness
1141− , "prefix_length" .= prefixLength
1142− , "analyzer" .= analyzer
1143− , "boost" .= boost ]]
1144−
1145−instance FromJSON FuzzyLikeFieldQuery where
1146− parseJSON = withObject "FuzzyLikeFieldQuery" parse
1147− where parse = fieldTagged $ \fn o ->
1148− FuzzyLikeFieldQuery fn
1149− <$> o .: "like_text"
1150− <*> o .: "max_query_terms"
1151− <*> o .: "ignore_tf"
1152− <*> o .: "fuzziness"
1153− <*> o .: "prefix_length"
1154− <*> o .: "boost"
1155− <*> o .:? "analyzer"
1156−
1157−instance ToJSON FuzzyLikeThisQuery where
1158− toJSON (FuzzyLikeThisQuery fields text maxTerms
1159− ignoreFreq fuzziness prefixLength boost analyzer) =
1160− omitNulls base
1161− where base = [ "fields" .= fields
1162− , "like_text" .= text
1163− , "max_query_terms" .= maxTerms
1164− , "ignore_tf" .= ignoreFreq
1165− , "fuzziness" .= fuzziness
1166− , "prefix_length" .= prefixLength
1167− , "analyzer" .= analyzer
1168− , "boost" .= boost ]
1169−
1170−instance FromJSON FuzzyLikeThisQuery where
1171− parseJSON = withObject "FuzzyLikeThisQuery" parse
1172− where parse o = FuzzyLikeThisQuery
1173− <$> o .:? "fields" .!= []
1174− <*> o .: "like_text"
1175− <*> o .: "max_query_terms"
1176− <*> o .: "ignore_tf"
1177− <*> o .: "fuzziness"
1178− <*> o .: "prefix_length"
1179− <*> o .: "boost"
1180− <*> o .:? "analyzer"
1181−
1182−instance ToJSON DisMaxQuery where
1183− toJSON (DisMaxQuery queries tiebreaker boost) =
1184− omitNulls base
1185− where base = [ "queries" .= queries
1186− , "boost" .= boost
1187− , "tie_breaker" .= tiebreaker ]
1188−
1189−instance FromJSON DisMaxQuery where
1190− parseJSON = withObject "DisMaxQuery" parse
1191− where parse o = DisMaxQuery
1192− <$> o .:? "queries" .!= []
1193− <*> o .: "tie_breaker"
1194− <*> o .:? "boost"
1195−
1196−instance ToJSON CommonTermsQuery where
1197− toJSON (CommonTermsQuery (FieldName fieldName)
1198− (QueryString query) cf lfo hfo msm
1199− boost analyzer disableCoord) =
1200− object [fieldName .= omitNulls base ]
1201− where base = [ "query" .= query
1202− , "cutoff_frequency" .= cf
1203− , "low_freq_operator" .= lfo
1204− , "minimum_should_match" .= msm
1205− , "boost" .= boost
1206− , "analyzer" .= analyzer
1207− , "disable_coord" .= disableCoord
1208− , "high_freq_operator" .= hfo ]
1209−
1210−instance FromJSON CommonTermsQuery where
1211− parseJSON = withObject "CommonTermsQuery" parse
1212− where parse = fieldTagged $ \fn o ->
1213− CommonTermsQuery fn
1214− <$> o .: "query"
1215− <*> o .: "cutoff_frequency"
1216− <*> o .: "low_freq_operator"
1217− <*> o .: "high_freq_operator"
1218− <*> o .:? "minimum_should_match"
1219− <*> o .:? "boost"
1220− <*> o .:? "analyzer"
1221− <*> o .:? "disable_coord"
1222−
1223−instance ToJSON CommonMinimumMatch where
1224− toJSON (CommonMinimumMatch mm) = toJSON mm
1225− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1226− object [ "low_freq" .= lowF
1227− , "high_freq" .= highF ]
1228−
1229−instance FromJSON CommonMinimumMatch where
1230− parseJSON v = parseMinimum v
1231− <|> parseMinimumHighLow v
1232− where parseMinimum = fmap CommonMinimumMatch . parseJSON
1233− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1234− MinimumMatchHighLow
1235− <$> o .: "low_freq"
1236− <*> o .: "high_freq")
1237−
1238−
1239−instance ToJSON BoostingQuery where
1240− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1241− object [ "positive" .= bqPositiveQuery
1242− , "negative" .= bqNegativeQuery
1243− , "negative_boost" .= bqNegativeBoost ]
1244−
1245−instance FromJSON BoostingQuery where
1246− parseJSON = withObject "BoostingQuery" parse
1247− where parse o = BoostingQuery
1248− <$> o .: "positive"
1249− <*> o .: "negative"
1250− <*> o .: "negative_boost"
1251−
1252−instance ToJSON BoolQuery where
1253− toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
1254− omitNulls base
1255− where base = [ "must" .= mustM
1256− , "filter" .= filterM'
1257− , "must_not" .= notM
1258− , "should" .= shouldM
1259− , "minimum_should_match" .= bqMin
1260− , "boost" .= boost
1261− , "disable_coord" .= disableCoord ]
1262−
1263−instance FromJSON BoolQuery where
1264− parseJSON = withObject "BoolQuery" parse
1265− where parse o = BoolQuery
1266− <$> o .:? "must" .!= []
1267− <*> o .:? "filter" .!= []
1268− <*> o .:? "must_not" .!= []
1269− <*> o .:? "should" .!= []
1270− <*> o .:? "minimum_should_match"
1271− <*> o .:? "boost"
1272− <*> o .:? "disable_coord"
1273−
1274−instance ToJSON MatchQuery where
1275− toJSON (MatchQuery (FieldName fieldName)
1276− (QueryString mqQueryString) booleanOperator
1277− zeroTermsQuery cutoffFrequency matchQueryType
1278− analyzer maxExpansions lenient boost
1279− minShouldMatch
1280− ) =
1281− object [ fieldName .= omitNulls base ]
1282− where base = [ "query" .= mqQueryString
1283− , "operator" .= booleanOperator
1284− , "zero_terms_query" .= zeroTermsQuery
1285− , "cutoff_frequency" .= cutoffFrequency
1286− , "type" .= matchQueryType
1287− , "analyzer" .= analyzer
1288− , "max_expansions" .= maxExpansions
1289− , "lenient" .= lenient
1290− , "boost" .= boost
1291− , "minimum_should_match" .= minShouldMatch
1292− ]
1293−
1294−instance FromJSON MatchQuery where
1295− parseJSON = withObject "MatchQuery" parse
1296− where parse = fieldTagged $ \fn o ->
1297− MatchQuery fn
1298− <$> o .: "query"
1299− <*> o .: "operator"
1300− <*> o .: "zero_terms_query"
1301− <*> o .:? "cutoff_frequency"
1302− <*> o .:? "type"
1303− <*> o .:? "analyzer"
1304− <*> o .:? "max_expansions"
1305− <*> o .:? "lenient"
1306− <*> o .:? "boost"
1307− <*> o .:? "minimum_should_match"
1308−
1309−instance ToJSON MultiMatchQuery where
1310− toJSON (MultiMatchQuery fields (QueryString query) boolOp
1311− ztQ tb mmqt cf analyzer maxEx lenient) =
1312− object ["multi_match" .= omitNulls base]
1313− where base = [ "fields" .= fmap toJSON fields
1314− , "query" .= query
1315− , "operator" .= boolOp
1316− , "zero_terms_query" .= ztQ
1317− , "tie_breaker" .= tb
1318− , "type" .= mmqt
1319− , "cutoff_frequency" .= cf
1320− , "analyzer" .= analyzer
1321− , "max_expansions" .= maxEx
1322− , "lenient" .= lenient ]
1323−
1324−instance FromJSON MultiMatchQuery where
1325− parseJSON = withObject "MultiMatchQuery" parse
1326− where parse raw = do o <- raw .: "multi_match"
1327− MultiMatchQuery
1328− <$> o .:? "fields" .!= []
1329− <*> o .: "query"
1330− <*> o .: "operator"
1331− <*> o .: "zero_terms_query"
1332− <*> o .:? "tie_breaker"
1333− <*> o .:? "type"
1334− <*> o .:? "cutoff_frequency"
1335− <*> o .:? "analyzer"
1336− <*> o .:? "max_expansions"
1337− <*> o .:? "lenient"
1338−
1339−instance ToJSON MultiMatchQueryType where
1340− toJSON MultiMatchBestFields = "best_fields"
1341− toJSON MultiMatchMostFields = "most_fields"
1342− toJSON MultiMatchCrossFields = "cross_fields"
1343− toJSON MultiMatchPhrase = "phrase"
1344− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
1345−
1346−instance FromJSON MultiMatchQueryType where
1347− parseJSON = withText "MultiMatchPhrasePrefix" parse
1348− where parse "best_fields" = pure MultiMatchBestFields
1349− parse "most_fields" = pure MultiMatchMostFields
1350− parse "cross_fields" = pure MultiMatchCrossFields
1351− parse "phrase" = pure MultiMatchPhrase
1352− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
1353− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
1354−
1355−instance ToJSON BooleanOperator where
1356− toJSON And = String "and"
1357− toJSON Or = String "or"
1358−
1359−instance FromJSON BooleanOperator where
1360− parseJSON = withText "BooleanOperator" parse
1361− where parse "and" = pure And
1362− parse "or" = pure Or
1363− parse o = fail ("Unexpected BooleanOperator: " <> show o)
1364−
1365−instance ToJSON ZeroTermsQuery where
1366− toJSON ZeroTermsNone = String "none"
1367− toJSON ZeroTermsAll = String "all"
1368−
1369−instance FromJSON ZeroTermsQuery where
1370− parseJSON = withText "ZeroTermsQuery" parse
1371− where parse "none" = pure ZeroTermsNone
1372− parse "all" = pure ZeroTermsAll
1373− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1374−
1375−instance ToJSON MatchQueryType where
1376− toJSON MatchPhrase = "phrase"
1377− toJSON MatchPhrasePrefix = "phrase_prefix"
1378−
1379−instance FromJSON MatchQueryType where
1380− parseJSON = withText "MatchQueryType" parse
1381− where parse "phrase" = pure MatchPhrase
1382− parse "phrase_prefix" = pure MatchPhrasePrefix
1383− parse t = fail ("Unexpected MatchQueryType: " <> show t)
1384−
1385−instance ToJSON ScoreType where
1386− toJSON ScoreTypeMax = "max"
1387− toJSON ScoreTypeAvg = "avg"
1388− toJSON ScoreTypeSum = "sum"
1389− toJSON ScoreTypeNone = "none"
1390−
1391−instance FromJSON ScoreType where
1392− parseJSON = withText "ScoreType" parse
1393− where parse "max" = pure ScoreTypeMax
1394− parse "avg" = pure ScoreTypeAvg
1395− parse "sum" = pure ScoreTypeSum
1396− parse "none" = pure ScoreTypeNone
1397− parse t = fail ("Unexpected ScoreType: " <> show t)
1398−
1399−instance ToJSON Distance where
1400− toJSON (Distance dCoefficient dUnit) =
1401− String boltedTogether where
1402− coefText = showText dCoefficient
1403− (String unitText) = toJSON dUnit
1404− boltedTogether = mappend coefText unitText
1405−
1406−instance FromJSON Distance where
1407− parseJSON = withText "Distance" parse
1408− where parse t = Distance <$> parseCoeff nT
1409− <*> parseJSON (String unitT)
1410− where (nT, unitT) = T.span validForNumber t
1411− -- may be a better way to do this
1412− validForNumber '-' = True
1413− validForNumber '.' = True
1414− validForNumber 'e' = True
1415− validForNumber c = isNumber c
1416− parseCoeff "" = fail "Empty string cannot be parsed as number"
1417− parseCoeff s = return (read (T.unpack s))
1418−
1419−instance ToJSON DistanceUnit where
1420− toJSON Miles = String "mi"
1421− toJSON Yards = String "yd"
1422− toJSON Feet = String "ft"
1423− toJSON Inches = String "in"
1424− toJSON Kilometers = String "km"
1425− toJSON Meters = String "m"
1426− toJSON Centimeters = String "cm"
1427− toJSON Millimeters = String "mm"
1428− toJSON NauticalMiles = String "nmi"
1429−
1430−
1431−instance FromJSON DistanceUnit where
1432− parseJSON = withText "DistanceUnit" parse
1433− where parse "mi" = pure Miles
1434− parse "yd" = pure Yards
1435− parse "ft" = pure Feet
1436− parse "in" = pure Inches
1437− parse "km" = pure Kilometers
1438− parse "m" = pure Meters
1439− parse "cm" = pure Centimeters
1440− parse "mm" = pure Millimeters
1441− parse "nmi" = pure NauticalMiles
1442− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1443−
1444−instance ToJSON DistanceType where
1445− toJSON Arc = String "arc"
1446− toJSON SloppyArc = String "sloppy_arc"
1447− toJSON Plane = String "plane"
1448−
1449−instance FromJSON DistanceType where
1450− parseJSON = withText "DistanceType" parse
1451− where parse "arc" = pure Arc
1452− parse "sloppy_arc" = pure SloppyArc
1453− parse "plane" = pure Plane
1454− parse t = fail ("Unrecognized DistanceType: " <> show t)
1455−
1456−
1457−instance ToJSON OptimizeBbox where
1458− toJSON NoOptimizeBbox = String "none"
1459− toJSON (OptimizeGeoFilterType gft) = toJSON gft
1460−
1461−instance FromJSON OptimizeBbox where
1462− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1463− <|> parseOptimize v
1464− where parseNoOptimize "none" = pure NoOptimizeBbox
1465− parseNoOptimize _ = mzero
1466− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1467−
1468−instance ToJSON GeoBoundingBoxConstraint where
1469− toJSON (GeoBoundingBoxConstraint
1470− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1471− object [gbbcGeoBBField .= gbbcConstraintBox
1472− , "_cache" .= cache
1473− , "type" .= type']
1474−
1475deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
1599deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
1476deleteSeveral ks hm = foldr HM.delete hm ks
1600deleteSeveral ks hm = foldr HM.delete hm ks
1477−
1478−instance FromJSON GeoBoundingBoxConstraint where
1479− parseJSON = withObject "GeoBoundingBoxConstraint" parse
1480− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1481− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1482− <$> parseJSON v
1483− <*> o .:? "_cache" .!= defaultCache
1484− <*> o .: "type"
1485− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1486−
1487−instance ToJSON GeoFilterType where
1488− toJSON GeoFilterMemory = String "memory"
1489− toJSON GeoFilterIndexed = String "indexed"
1490−
1491−instance FromJSON GeoFilterType where
1492− parseJSON = withText "GeoFilterType" parse
1493− where parse "memory" = pure GeoFilterMemory
1494− parse "indexed" = pure GeoFilterIndexed
1495− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1496−
1497−instance ToJSON GeoBoundingBox where
1498− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1499− object ["top_left" .= gbbTopLeft
1500− , "bottom_right" .= gbbBottomRight]
1501−
1502−instance FromJSON GeoBoundingBox where
1503− parseJSON = withObject "GeoBoundingBox" parse
1504− where parse o = GeoBoundingBox
1505− <$> o .: "top_left"
1506− <*> o .: "bottom_right"
1507−
1508−instance ToJSON LatLon where
1509− toJSON (LatLon lLat lLon) =
1510− object ["lat" .= lLat
1511− , "lon" .= lLon]
1512−
1513−instance FromJSON LatLon where
1514− parseJSON = withObject "LatLon" parse
1515− where parse o = LatLon <$> o .: "lat"
1516− <*> o .: "lon"
1517−
1518−-- index for smaller ranges, fielddata for longer ranges
1519−instance ToJSON RangeExecution where
1520− toJSON RangeExecutionIndex = "index"
1521− toJSON RangeExecutionFielddata = "fielddata"
1522−
1523−
1524−instance FromJSON RangeExecution where
1525− parseJSON = withText "RangeExecution" parse
1526− where parse "index" = pure RangeExecutionIndex
1527− parse "fielddata" = pure RangeExecutionFielddata
1528− parse t = error ("Unrecognized RangeExecution " <> show t)
1529−
1530−instance ToJSON RegexpFlags where
1531− toJSON AllRegexpFlags = String "ALL"
1532− toJSON NoRegexpFlags = String "NONE"
1533− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1534− where flagStrs = map flagStr . nub $ h:fs
1535− flagStr AnyString = "ANYSTRING"
1536− flagStr Automaton = "AUTOMATON"
1537− flagStr Complement = "COMPLEMENT"
1538− flagStr Empty = "EMPTY"
1539− flagStr Intersection = "INTERSECTION"
1540− flagStr Interval = "INTERVAL"
1541−
1542−instance FromJSON RegexpFlags where
1543− parseJSON = withText "RegexpFlags" parse
1544− where parse "ALL" = pure AllRegexpFlags
1545− parse "NONE" = pure NoRegexpFlags
1546− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1547−
1548−instance FromJSON RegexpFlag where
1549− parseJSON = withText "RegexpFlag" parse
1550− where parse "ANYSTRING" = pure AnyString
1551− parse "AUTOMATON" = pure Automaton
1552− parse "COMPLEMENT" = pure Complement
1553− parse "EMPTY" = pure Empty
1554− parse "INTERSECTION" = pure Intersection
1555− parse "INTERVAL" = pure Interval
1556− parse f = fail ("Unknown RegexpFlag: " <> show f)
1557−
1558−instance ToJSON Term where
1559− toJSON (Term field value) = object ["term" .= object
1560− [field .= value]]
1561−
1562−instance FromJSON Term where
1563− parseJSON = withObject "Term" parse
1564− where parse o = do termObj <- o .: "term"
1565− case HM.toList termObj of
1566− [(fn, v)] -> Term fn <$> parseJSON v
1567− _ -> fail "Expected object with 1 field-named key"
1568−
1569−instance ToJSON BoolMatch where
1570− toJSON (MustMatch term cache) = object ["must" .= term,
1571− "_cache" .= cache]
1572− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1573− "_cache" .= cache]
1574− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1575− "_cache" .= cache]
1576−
1577−instance FromJSON BoolMatch where
1578− parseJSON = withObject "BoolMatch" parse
1579− where parse o = mustMatch `taggedWith` "must"
1580− <|> mustNotMatch `taggedWith` "must_not"
1581− <|> shouldMatch `taggedWith` "should"
1582− where taggedWith parser k = parser =<< o .: k
1583− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1584− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1585− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache